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

• Delila_1 veterán

  #9902

  #9901 bozsozso

  2011-04-01 16:40:00

  Új Válasz

  Ú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

  

  Delila_1

  veterán

  #9901 bozsozso

  #9901 bozsozso

  Szia!

  Az alap kód az ez lenne:
  Sub Összegzés()
  Dim usorA As Long, usorG As Long, usor2A As Long
  Sheets("Munka1").Select
  usorA = Range("A1").End(xlDown).Row 'Alsó sor a Munka1 lapon
  'Irányított szűrés egyedi ('A' oszlop) értékekre a G1-be
  Range("A1:A" & usorA).AdvancedFilter Action:=xlFilterCopy, _
  CopyToRange:=Range("G1"), Unique:=True
  'Alsó sor a G oszlopban
  usorG = Range("G1").End(xlDown).Row
  'Első üres sor a Munka2 lap A oszlopában
  usor2A = Sheets("Munka2").Range("A5000").End(xlUp).Row + 1
  'Munka1 G oszlopának másolása a Munka2 A oszlopába
  Range("G2:G" & usorG).Copy Sheets("Munka2").Range("A" & usor2A)
  Sheets("Munka2").Select
  'Szumha képlet a Munka2!B-be
  Range("B2:B" & Range("A5000").End(xlUp).Row).Select
  Selection = "=SUMIF(Munka1!A:A,Munka2!A2,Munka1!B:B)"
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues
  Cells(2, 1).Select
  'Munka1!G törlése
  Sheets("Munka1").Columns(7).Delete
  End Sub

  Ami annyit tesz, hogy egyik munkalapról a másik munkalapra összesít azonos terméknevek mennyiségeit, de mivel ebben szerepel szerepel ár is ami az azonos termékeknél ugyan az, ezért szeretném még azt is átvinni a másik munkalapra. Ez lenne a H illetve I oszlopban.

  Ez az új a Munka2 lapon a B oszlopba írja a Munka1 H oszlopát, és a C-be az I-t.

  Sub Összegzés()
  Dim usorA As Long, usorT As Long, usor2A As Long
  
  Sheets("Munka1").Select
  usorA = Range("A1").End(xlDown).Row 'Alsó sor a Munka1 lapon
  
  'Irányított szűrés egyedi ('A' oszlop) értékekre a T1-be
  Range("A1:A" & usorA).AdvancedFilter Action:=xlFilterCopy, _
  CopyToRange:=Range("T1"), Unique:=True
  
  'Alsó sor a T oszlopban
  usorT = Range("T1").End(xlDown).Row
  
  'Első üres sor a Munka2 lap A oszlopában
  usor2A = Sheets("Munka2").Range("A5000").End(xlUp).Row + 1
  
  'Munka1 T oszlopának másolása a Munka2 A oszlopába
  Range("T2:T" & usorT).Copy Sheets("Munka2").Range("A" & usor2A)
  
  Sheets("Munka2").Select 'Szumha képlet a Munka2!B-be
  usorA = Range("A1000").End(xlUp).Row
  Range("B2:B" & usorA).Select
  Selection = "=SUMIF(Munka1!A:A,Munka2!A2,Munka1!B:B)"
  Range("C2:C" & usorA) = "=VLOOKUP(A2:A" & usorA & ",Munka1!A:I,8,0)"
  Range("D2:D" & usorA) = "=VLOOKUP(A2:A" & usorA & ",Munka1!A:I,9,0)"
  Range("A:D").Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False
  Cells(2, 1).Select
  
  'Munka1!T oszlop törlése
  Sheets("Munka1").Columns(20).Delete
  End Sub

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