[jak]

Meine Idee:
Die ganze Tabelle drei mal durchlaufen, beim ersten mal zählen und in eine Spalte schreiben, beim zweiten Mal die einfachen löschen und beim dritten mal das ganze "zusammenkopieren" damit keine Leerzeilen sind.

Ist die Reihenfolge irgendwie wichtig, oder kann man vor der Ausführung die Spalte A sortieren? Würde einiges vereinfachen...

Han das nicht ausprobiert:

Private Function findDublicate(row As Integer, targetCol As Integer, in_table As String) As Integer
'Prueft ob ein Eintrag bereits existiert
Dim i As Integer, a, b As String
a = Worksheets(in_table).Cells(row, 1).Value
i = 1
findDublicate = -1
Do
 b = Worksheets(in_table).Cells(i, 1).Value
  If (a = b) Then
  findDublicate = i
  Exit Do
  End If
 i = i + 1
Loop While (i < row)
End Function
Private Sub increase(inTable As String, row As Integer, col As Integer)
 With (Worksheets(inTable).Cells(row, col))
  If (Value <> "") Then Value = Value + 1
  Else: Value = 1
  End If
 End With
End Sub
Private Sub Count(targetCol As Integer)
Dim row, currentRow  As Integer
Dim tempCell
currentRow = 0
Do
 currentRow = currentRow + 1
 tempCell = Worksheets("Tabelle1").Cells(currentRow, 1)
 row = findDublicate(currentRow, targetCol, "Tabelle1")
 If (row <> -1) Then Call increase("Tabelle1", currentRow, targetCol)
 End If
Loop While (tempCell.Value <> "")
End Sub
Private Sub Delete(targetCol As Integer)
'Delete löscht nur die Spalten die einzeln sind, sortiert aber keine Doppelten Einträge aus.
'Wenn du das willst musst du statt
'if ...Value = 1) if ((c.Value = 1) Or (c.Value=""))
'schreiben.
Dim i As Integer
i = 0
Do
 i = i + 1
 If (Worksheets("Tabelle1").Cells(i, targetCol).Value = 1) Then
  Worksheets("Tabelle1").Cells(i, 1).Value = ""
  'Wenn du noch weitere Zellen löschen willst kannst du das hier dazuschreiben:
  'Worksheets("Tabelle1").Cells(i, 2).Value = ""
  'Worksheets("Tabelle1").Cells(i, 3).Value = ""
 End If
Loop While (Worksheets("Tabelle1").Cells(i, 1).Value <> "")
End Sub
Private Sub copy()
'Not implemented
End Sub

Sub main()
Dim targerCol As Integer
'targetCol ist die Spalte, in die die "Zählung" geschrieben wird
targetCol = 2
Call Count(targetCol)
Call Delete(targetCol)
copy
End Sub

Jak