01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25 |
|
Sub AListe_BListeA10()
Dim iZl As Long, rZelle As Range, iCount(3) As Integer, rSpalte As Range
' Läuft durch die Liste1
Set rSpalte = Sheets("Liste2").Columns(14)
With Sheets("Liste1")
For iZl = 3 To .Cells(.Rows.Count, "C").End(xlUp).Row
Erase iCount
Set rZelle = rSpalte.Find(.Cells(iZl, "C").Value, lookat:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
ErsteAddresse = rZelle.Address ' Erste Fundadresse merken
Do
iCount(0) = iCount(0) + 1 ' Gesamtzähler
If Sheets("LISTE2").Cells(rZelle.Row, "L").Value = "1 Gigabit Ethernet" Then
iCount(1) = iCount(1) + 1 ' Teilzähler1
Else
iCount(2) = iCount(2) + 1 ' Teilzähler2
End If
Set rZelle = rSpalte.FindNext(rZelle) ' Nächtes suchen
Loop While Not rZelle Is Nothing And rZelle.Address <> ErsteAddresse
.Cells(iZl, "J").Resize(, 3).Value = iCount ' Zähler ausgeben
End If
Next iZl
End With
End Sub
|