AW: Anzahl ermitteln (mit Bedingung)
28.03.2012 15:21:46
ChrisL
Hi Jörg
Beispiel im Anhang.
https://www.herber.de/bbs/user/79592.xls
cu
Chris
Private Sub Worksheet_Activate()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim i As Long, ii As Long
Set WS1 = Worksheets("Daten")
Set WS2 = Worksheets("Auswertung")
Application.ScreenUpdating = False
With WS2
.Cells.Delete
WS1.Cells.Copy .Range("A1")
For i = .Range("A65536").End(xlUp).Row To 2 Step -1
For ii = i - 1 To 2 Step -1
If .Cells(i, 1) = .Cells(ii, 1) And Left(.Cells(i, 2), 2) = Left(.Cells(ii, 2), 2) _
Then
.Rows(ii).Delete
Exit For
End If
Next ii
Next i
.Range("B1") = "Anzahl"
For i = 2 To .Range("A65536").End(xlUp).Row
.Cells(i, 2) = WorksheetFunction.CountIf(.Columns(1), .Cells(i, 1))
Next i
For i = .Range("A65536").End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(.Columns(1), .Cells(i, 1)) > 1 Then _
.Rows(i).EntireRow.Delete
Next i
End With
Application.ScreenUpdating = True
End Sub