Doppler im Array finden und markieren

Hallo Excelianer,
ich fülle ein eindimensionales Array mit Begriffen aus einem CSV-File (seeeehr viele Begriffe). Anschließend will ich das Array nach Dopplern durchsuchen, diese möchte ich allerdings nicht entfernen sondern umbenennen. Dabei soll vor den gefundenen Doppler eine Ziffer z. B. eine "1" oder einfach die Position im Array geschrieben werden. Der nächste Doppler erhielte dann eine "2" usw.. Alternativ könnten die Doppler mit Angabe der eigentlichen Position im Array in eine Tabelle geschrieben werden
Wie könnte das funktionieren?
Finde keinen richtigen Ansatz.
Die Lösung Hilfstabelle und farbliches Markieren der Doppler kenne ich schon, ist mir aber eigentlich zu umständlich, weil die Aufgabe ziemlich häufig auf mich zukommt.
Gruß
Jochen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'erstellt unter Excel 2010 Sub DoppelteMarkieren() Dim arrData, Zeile As Long, Zeile2 As Long, lCount As Long Dim arrDoppelt() As Boolean, varWert Call getdata(arrData) ReDim arrDoppelt(LBound(arrData) To UBound(arrData)) For Zeile = LBound(arrData) To UBound(arrData) If arrDoppelt(Zeile) = False Then lCount = 0 varWert = arrData(Zeile) For Zeile2 = Zeile + 1 To UBound(arrData) If arrDoppelt(Zeile2) = False Then If arrData(Zeile2) = varWert Then arrDoppelt(Zeile2) = True lCount = lCount + 1 arrData(Zeile2) = "'" & Format(lCount, "0") & " " & arrData(Zeile) End If End If Next End If Next 'Wertausgabe Application.ScreenUpdating = False lCount = 0 For Zeile = LBound(arrData) To UBound(arrData) Range("B1").Offset(lCount, 0) = arrData(Zeile) lCount = lCount + 1 Next Application.ScreenUpdating = True End Sub Sub getdata(Data) 'nur zum Testen Dim UG As Long, OG As Long, Zeile As Long With ActiveSheet UG = 1 OG = .Cells(.Rows.Count, 1).End(xlUp).Row ReDim Data(UG To OG) For Zeile = UG To OG Data(Zeile) = .Cells(Zeile, 1).Value Next End With End Sub

Hi
schau dir das mal an, wie von dir beschrieben für ein eindimensionales Array (sollte aber auch leicht umschreibbar sein für ein zweidimensionales mit einer Spalte)
an der Sub-Benennung erkennst du die Markierungsart

Sub DopplerMarkieren_mit_ArrPosition()
Dim dic
Dim Arr
Dim i As Long
Arr = Array("AAA", "BBB", "AAA", "CCC", "AAA", "BBB")
Set dic = CreateObject("Scripting.dictionary")
For i = LBound(Arr) To UBound(Arr)
If dic.Exists(Arr(i)) Then
Arr(i) = i & " - " & Arr(i)
Else
dic(Arr(i)) = 0
End If
Next
End Sub


Sub DopplerMarkieren_mit_WiederholungsAnzahl()
Dim dic
Dim Arr
Dim i As Long
Arr = Array("AAA", "BBB", "AAA", "CCC", "AAA", "BBB")
Set dic = CreateObject("Scripting.dictionary")
For i = LBound(Arr) To UBound(Arr)
If dic.Exists(Arr(i)) Then
dic(Arr(i)) = dic(Arr(i)) + 1
Arr(i) = dic(Arr(i)) & " - " & Arr(i)
Else
dic(Arr(i)) = 1
End If
Next
End Sub

für das arr = Array(... musst du natürlich dein Befüllung des Arrays einsetzen.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Doppler im Array finden und markieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

194 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Doppler im Array finden und markieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

194 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread