So, ich habe jetzt die drei unterschielichen Suchvarianten durch.
Hier die letzte mit dem Autofilter:
Sub B_A10()
Dim DeinArr As Variant
Dim Zindex As Long
Dim iCount(3), total, G10 As Integer
Application.ScreenUpdating = False
DeinArr = Sheets("LISTE1").Range("C3:C" & Sheets("LISTE1").UsedRange.SpecialCells(xlCellTypeLastCell).Row)
'DeinArr = Sheets("A").Range("C3:C6")
If Sheets("LISTE2").AutoFilterMode Then
Sheets("LISTE2").AutoFilterMode = False
End If
For Zindex = 1 To UBound(DeinArr)
With Sheets("LISTE2")
.Range("A2:N" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).AutoFilter Field:=14, Criteria1:=DeinArr(Zindex, 1)
'soweit ok. Excel filtert jeden wert aus sheetsLISTE1 1:Ende im Sheet Liste2 spalte N
total = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
'hier wird die Anzahl der Reihen gezählt. soweit ok
'Wollte eigentlich noch in zwei Kriterien unterteilen, aber die Funktion ist auch schon so sehr langsam
' . Range("A2:N" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).AutoFilter Field:=12, _
' Criteria1:="10 Gigabit Ethernet"
' G10 = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
End With
Sheets("LISTE1").Cells((Zindex + 2), 13).Value = total
' Sheets("LISTE1").Cells((Zindex + 2), 14).Value = G10
Next Zindex
Application.ScreenUpdating = True
End Sub
Ergebnis:
For loop durch beide Listen: Code ran successfully in 249,74 seconds |
|
Find/FindNex: Code ran successfully in 81,92 seconds
Autofilter: Code ran successfully in 372,73 seconds (hier nur nach einem Kriterium gefiltert und ohne die Fallunterscheidung
|
|
|
|
|