Excel - doppelte Einträge

[jak]

hab' dich wohl falsch verstanden.
Der Code soltle das gewünschte erledigen:


'Prueft ob ein Eintrag bereits existiert
Private Function findDublicate(row As Long, col As Long, in_table As String) As Long
Dim i As Integer, a, b As String
a = Worksheets(in_table).Cells(row, col).Value
i = 1
findDublicate = -1
Do
b = Worksheets(in_table).Cells(i, col).Value
If (a = b) Then
findDublicate = i
Exit Do
End If
i = i + 1
Loop While (i < row)
End Function

Private Function find(whatText As String, whatCol As Long, fromWB As String) As Long
Dim row As Integer, a As String
row = 0
Do
row = row + 1
a = Worksheets(fromWB).Cells(row, whatCol).Value
If (a = whatText) Then Exit Do
Loop While a <> ""
find = row
End Function

'erhoeht die Zahl
Private Sub increase(inTable As String, srcRow As Long, tCol As Long)
Dim temp
Dim tRow As Long
Dim srcText As String
srcText = Worksheets(inTable).Cells(srcRow, 1).Value
tRow = find(srcText, tCol, "Tabelle1")
'kopiert beim 1.Mal den Text aus Spalte A
If (Worksheets(inTable).Cells(tRow, tCol).Value = "") Then Worksheets(inTable).Cells(tRow, tCol).Value = Worksheets(inTable).Cells(srcRow, tCol - 1).Value
tCol = tCol + 1
'Wenn in der Zählspalte schon was steht wird die Zahl erhöht
If Worksheets(inTable).Cells(tRow, tCol).Value <> "" Then Worksheets(inTable).Cells(tRow, tCol).Value = Worksheets(inTable).Cells(tRow, tCol).Value + 1
'Sonst auf 2 gesetzt
If Worksheets(inTable).Cells(tRow, tCol).Value = "" Then Worksheets(inTable).Cells(tRow, tCol).Value = 2
End Sub

Sub main()
Dim row, currentRow, targerCol, targetRow As Long
'targetCol ist die Spalte, in die die "Zählung" geschrieben wird (A=1, B=2, C=3,...)
targetCol = 2
currentRow = 1
targetRow = 1
row = 0
Do
currentRow = currentRow + 1
row = findDublicate((currentRow), 1, "Tabelle1")
If (row <> -1) Then
Call increase("Tabelle1", (row), (targetCol))
End If
Loop While (Worksheets("Tabelle1").Cells(currentRow, 1).Value <> "")
End Sub


Hab's aber nicht ausprobiert, versuch es halt an einer Kopie der Daten...

Es wird angenommen, daß die Tabelle aus ist, wenn eine Zelle der Spalte A leer ist.

Du sagst etwas von 18000 Zeilen, das könnte mit dem Code seeehr lange dauern, er ist ziemlich ineffizent.

Siehe test.zip

Jak

<edit>war zu langsam, versuch mal den Code von Flinx, ist vermutlich besser...</edit>