Doppler im Array finden und markieren

Bild

Betrifft: Doppler im Array finden und markieren
von: JoWE
Geschrieben am: 28.09.2015 13:16:42

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

Bild

Betrifft: AW: Doppler im Array finden und markieren
von: fcs
Geschrieben am: 28.09.2015 14:37:15
Hallo Jochen,
hier mein Vorschlag.
Gruß
Franz

'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


Bild

Betrifft: AW: Doppler im Array finden und markieren
von: JoWE
Geschrieben am: 28.09.2015 14:49:51
Hallo Franz,
ja - das war's!

Habe diese Zeile
'arrData(Zeile2) = "'" & Format(lCount, "0") & " " & arrData(Zeile)'

durch diese Zeile
'arrData(Zeile2) = "'" & Format(Zeile, "0") & " " & arrData(Zeile)'
ersetzt. Damit habe ich mein Wunschergebnis zu 100% erreicht.
Prima, danke Dir.
Gruß
Jochen

Bild

Betrifft: AW: Doppler im Array finden und markieren
von: Daniel
Geschrieben am: 28.09.2015 15:24:54
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

Bild

Betrifft: AW: Doppler im Array finden und markieren
von: JoWE
Geschrieben am: 28.09.2015 15:41:55
Hallo Daniel,
auch Dir vielen Dank.
Mit dem Dictionary-Objekt hatte ich es auch schon probiert, kam aber nicht klar.
Dank Deiner beiden Codes hab' ich's jetzt aber kapiert.
Gruß
Jochen

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Doppler im Array finden und markieren "