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

• #32556 Delila_1 veterán Zozzy #32554

  Új Válasz 2016-09-02 10:16:50 #32556

  Ú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

  

  Delila_1

  veterán

  válasz Zozzy #32554 üzenetére

  Akkor gyorsítsunk – bár úgy tapasztaltam, hogy sok sor esetén nem túl gyors az Excelben a szűrés.
  A makró a B oszlop adataiból speciális szűréssel kimásolja az egyedi adatokat az AA oszlopba, onnan veszi, hogy milyen adatokra kell szűrni a tartományt. Ha az AA oszlopban vannak adataid, minden helyen írd át az AA-t nagyobb oszlop nevére.

  Az adatokat tartalmazó lapon állva kell indítani a makrót.

  Sub Kulon_Lapra_1()
Dim sor As Long, lapnev As String, WS1 As Worksheet

Application.ScreenUpdating = False
Set WS1 = ActiveSheet

'egyedi rekordok az AA oszlopba
WS1.Range("B1:B" & Application.CountA(WS1.Columns(2))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True

sor = 2
Do While Cells(sor, "AA") <> ""
lapnev = Cells(sor, "AA")

WS1.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=lapnev 'szűrés

Sheets.Add After:=Sheets(Sheets.Count) 'új lap létrehozása
ActiveSheet.Name = lapnev

WS1.Range("A1").CurrentRegion.Copy Sheets(lapnev).Cells(1) 'másolás
WS1.Activate
sor = sor + 1
Loop
WS1.Range("A1").CurrentRegion.AutoFilter Field:=2 'szűrő visszaállítása
Application.ScreenUpdating = True
End Sub

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