AW: VBA-Version
15.06.2016 11:36:06
Fennek
Hallo,
hier ein VBA-Ansatz: Voraussetzung ist, dass Sheets(2) existiert und leer ist.
Sub Dict_Jannick_Her()
Sheets(2).Cells.Clear
lr = Cells(Rows.Count, "A").End(xlUp).Row
With CreateObject("scripting.dictionary")
For i = 3 To lr
k = Cells(i, "A").Value
If Not .exists(k) Then
.Add (Cells(i, "A").Value), Cells(i, "D")
Else
.Item(k) = .Item(k) & "|" & Cells(i, "D")
End If
Next i
For i = 1 To .Count
'Debug.Print .Count, .keys
Sheets(2).Cells(2, "A").Resize(.Count) = Application.Transpose(.keys)
Sheets(2).Cells(2, "D").Resize(.Count) = Application.Transpose(.Items)
Next i
End With
With Sheets(2)
lr = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("B2:B" & lr).FormulaR1C1 = "=VLOOKUP(TEXT(RC[-1],""@""),Tabelle1!R[1]C[-1]:R[20000]C[2], _
2,FALSE)"
.Range("C2:C" & lr).FormulaR1C1 = "=VLOOKUP(TEXT(RC[-2],""@""),Tabelle1!R[1]C[-2]:R[20000]C[1], _
3,FALSE)"
.Range("D2:D" & lr).TextToColumns Destination:=Range("D2"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
TrailingMinusNumbers:=True
.Range("B:C").Value = .Range("B:C").Value
End With
End Sub
Vermutlich bedarf es noch ein paar Adaptionen, also wenn etwas nicht passt, bitte eine aussagekräftige Beschreibung, eventuell auch eine Datei mit ca 100 Zeilen.
mfg