Problem mit doppeltem Scripting.Dictionary
04.12.2013 14:22:40
Franco
Ich möchte in der Spalte N der Tabelle 1 nach C in Tabelle 3 kopieren. Dabei möchte ich sämtliche doppelte sowie leere Inhalte nicht kopieren. Dies Funktioniert mit der " Scripting.Dictionary"-Funktion einwandfrei und sehr schnell. Nun möchte ich die Funktion erweitern und die Einträge in Spalte O der Tabelle 1 ebenfalls mit nach Tabelle 3 Spalte B kopieren. Ich habe das folgendermassen Probiert, jedoch kopiert er mit die Werte aus N.
Hat jemand eine Idee?
Sub copy()
' Intitalisierung Kategorie
Dim nD As Object, rngN As Range
Set nD = CreateObject("Scripting.Dictionary")
Dim oD As Object
Set oD = CreateObject("Scripting.Dictionary")
With Sheets(1)
For Each rngN In .Range(.Cells(9, 14), .Cells(Rows.count, 14).End(xlUp))
If rngN 0 Then
If Not nD.exists(rngN.Value) Then
nD.Add rngN.Value, rngN.count
oD.Add rngN.Offset(0, 1), rngN.Offset(0, 1)
MsgBox rngN.Offset(0, 1).Value
End If
End If
Next
End With
Sheets(3).Cells(2, 3).Resize(nD.count) = WorksheetFunction.Transpose(nD.keys)
Sheets(3).Cells(2, 2).Resize(oD.count) = WorksheetFunction.Transpose(nD.keys)
End Sub