AW: doppelte Werte in Tabelle
07.03.2019 15:14:57
Nepumuk
Hallo Flo,
teste mal:
Public Sub CompleteItems()
Dim avntValues As Variant
Dim ialngIndex As Long
Dim objDictionary As Object
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
With Worksheets("Tabelle1")
avntValues = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)).Value
For ialngIndex = LBound(avntValues, 1) To UBound(avntValues, 1)
If Not objDictionary.Exists(avntValues(ialngIndex, 1)) Then _
If Not IsEmpty(avntValues(ialngIndex, 2)) Then _
Call objDictionary.Add(avntValues(ialngIndex, 1), avntValues(ialngIndex, 2))
Next
For ialngIndex = LBound(avntValues, 1) To UBound(avntValues, 1)
If IsEmpty(avntValues(ialngIndex, 2)) Then _
If objDictionary.Exists(avntValues(ialngIndex, 1)) Then _
avntValues(ialngIndex, 2) = objDictionary(avntValues(ialngIndex, 1))
Next
.Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2)).Value = avntValues
End With
Set objDictionary = Nothing
End Sub
Gruß
Nepumuk