Új hozzászólás Aktív témák

• #14153 zz76zz csendes tag

  Új Válasz 2012-06-28 10:37:57 #14153

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  zz76zz

  csendes tag

  végül sikerült, kis segítséggel összehozni. de (ugye, mert mindig van egy de) 2007 es excelben csináltam és, ahol használnák 2003 van, ami nem ismeri a hahiba utasítást (meg lehet másikat sem.
  van e valamilyen fordító, vagy akármi más megoldás, hogy tudkjon azon is futni?
  az office kompatibilitás csomag nem hozott eredményt.
  a kód kommentezve, ha érdekel valakit:

  Sub Makró1()
  '
  ' Makró1 Makró
  '

  '
  'mielőtt bármit csinálnánk szám formátumra vesszük az egészet. ez azért kell, hogy az excel ne formázza automatikusan dátummá bizonyos karaktersorozatokat'
  Selection.NumberFormat = "@"
  'az excel mégis dátumozna, ezért a / vezérlőkaraktereke eltávolítjuk'
  Selection.Replace What:="/", Replacement:="", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  ReplaceFormat:=False
  'a számokat a pdf x.0 formában hozza. ez zavarhat a későbbi számolásban: leszedjük'
  Selection.Replace What:=".0", Replacement:="", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  ReplaceFormat:=False

  Range("A1").Select
  Range("A1:A6000").Select

  'oszlopra bontjuk a katyvaszt'
  Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
  Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
  :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
  Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True

  Range("N1").Select

  'az N, item, és 12vel kezdődőek megjelölése'
  ActiveCell.FormulaR1C1 = _
  "=IF(RC[-13]=""n"",1,IF(RC[-13]=""item"",1,IF(SEARCH(""12*"",RC[-13],1)=1,1,"""")))"
  Range("N1").Select

  '6000 sor mélységig vizsgálunk'
  Selection.AutoFill Destination:=Range("N16000"), Type:=xlFillDefault
  Range("N16000").Select

  Range("A1").Select
  Selection.AutoFilter
  ActiveSheet.Range("$A$1:$Z$6000").AutoFilter Field:=14, Criteria1:="1"
  Rows("2:6000").Select
  'megjelöltek másolása a munka2 be'
  Selection.Copy
  Sheets("Munka2").Select
  Range("A2").Select
  ActiveSheet.Paste
  Range("A1").Select
  'beszúrunk 6 oszlopot a későbbi részműveletekhez'
  Columns("B").Select
  Application.CutCopyMode = False
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Columns("E:E").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Range("B,C,E:E,F,N,O").Select
  Range("O1").Activate
  'a szöveges cellaformátumot átalakítjuk általánosra különben a képleteink szövegként leperegnek az excelről'
  Selection.NumberFormat = "General"
  Range("B1").Select
  'dátum van e az első oszlopban?'
  ActiveCell.FormulaR1C1 = "=IFERROR(1=SEARCH(""12*"",RC[-1],1),0)"
  Range("C1").Select
  ActiveCell.FormulaR1C1 = "=IF(RC[-1]=0,LEFT(RC[5],6),RC[-2])"
  'ha igen, akkor onnan szedjük a dátumot, ha nem akkor másik dátum oszlopból'
  Range("B11").Select
  '3000 sormélységig vizsgálunk'
  Selection.AutoFill Destination:=Range("B13000"), Type:=xlFillDefault
  Range("B13000").Select
  Range("E1").Select
  'a fentihez hasonló vizsgálat rendelésszámra'
  ActiveCell.FormulaR1C1 = "=IFERROR(1=SEARCH(""4521*"",RC[-1],1),0)"
  Range("F1").Select
  'ha nincs, akkor az forcast rendelés'
  ActiveCell.FormulaR1C1 = "=IF(RC[-1]=0,""Forecast"",RC[-2])"
  Range("E11").Select
  Selection.AutoFill Destination:=Range("E13000"), Type:=xlFillDefault
  Range("E13000").Select
  Range("N1").Select
  'keressük a cikkszámokat'
  ActiveCell.FormulaR1C1 = "=IFERROR(1=SEARCH(""sfv-*"",RC[-6],1),0)"
  Range("N1").Select
  Selection.AutoFill Destination:=Range("N13000"), Type:=xlFillDefault
  Range("N13000").Select
  Range("O2").Select
  'ha találunk adott helyen, akkor beírjuk, ha nem, akkor úgy veszzük mintha az előző cikk volna'
  ActiveCell.FormulaR1C1 = "=IF(RC[-1],RC[-7],R[-1]C)"
  Selection.AutoFill Destination:=Range("O23000"), Type:=xlFillDefault
  Range("O23000").Select
  'vizsgáljuk hogy n van e, mert akkor mást kell beírni'

  Range("i1").Select
  ActiveCell.FormulaR1C1 = "=IFERROR(1=SEARCH(""n"",RC[-8],1),0)"
  Selection.AutoFill Destination:=Range("i1:i3000"), Type:=xlFillDefault
  Range("i1:i3000").Select

  Range("j1").Select
  ActiveCell.FormulaR1C1 = "=IF(RC[-1],RC[1],RC[-3])"
  Selection.AutoFill Destination:=Range("j1:j3000"), Type:=xlFillDefault
  Range("j1:j3000").Select
  'számformátumizálás'

  Columns("J:J").Select
  Selection.NumberFormat = "0"

  Columns("C").Select
  Application.CutCopyMode = False
  Selection.Copy
  Range("Q1").Select
  'értéket básolunk irányított beillesztéssel'
  ActiveSheet.Paste
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Range("R2").Select
  Application.CutCopyMode = False
  'a dátumjaink ééhhnn formában vannak. kicsit kiszépétjük, hogy ééééhhnn formába kerüljenek'
  ActiveCell.FormulaR1C1 = "=RC[-1]+20000000"
  Range("R2").Select
  Selection.AutoFill Destination:=Range("R23000"), Type:=xlFillDefault
  Range("R23000").Select
  'kiszűrjük azon sorokat, amik nem tartalmaznak már számunkra értékes információt'
  Range("A1").Select
  Selection.AutoFilter
  ActiveSheet.Range("$A$1:$AD$3000").AutoFilter Field:=18, Criteria1:=">2010" _
  , Operator:=xlAnd
  Columns("D").ColumnWidth = 13.57
  Columns("F").ColumnWidth = 10.86

  'munka3 ba másoljuk a kész adatokat és formázgatjuk:'
  Range("F,J:J,O,R").Select
  Range("R1").Activate
  Selection.Copy
  Sheets("Munka3").Select
  Cells.Select
  Application.CutCopyMode = False
  Selection.ClearContents
  Range("A1").Select
  Sheets("Munka2").Select
  Selection.Copy
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Munka3").Select
  ActiveSheet.Paste
  Range("A1").Select
  Application.CutCopyMode = False
  ActiveCell.FormulaR1C1 = "rendelésszám"
  Range("B1").Select
  ActiveCell.FormulaR1C1 = "mennyiség"
  Range("C1").Select
  ActiveCell.FormulaR1C1 = "cikk"
  Range("D1").Select
  ActiveCell.FormulaR1C1 = "szállítási idő"
  Range("E1").Select

  Columns("A").Select
  Columns("A").EntireColumn.AutoFit
  With Selection
  .HorizontalAlignment = xlRight
  .VerticalAlignment = xlBottom
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False
  End With
  Range("A1").Select

  End Sub

Új hozzászólás Aktív témák