Option Explicit
Sub Test()
Dim rngCities As Excel.Range
Dim vntCities() As Variant
Dim i As Long
Dim j As Long
Dim k As Long
With Worksheets("DatenEingabe")
Set rngCities = .Cells(.Rows.Count, "A").End(xlUp)
Set rngCities = .Range(.Range("A1"), rngCities)
End With
ReDim vntCities(1 To WorksheetFunction.Combin(rngCities.Cells.Count, 2), 1 To 2)
For i = 1 To rngCities.Cells.Count
For j = i + 1 To rngCities.Cells.Count
k = k + 1
vntCities(k, 1) = rngCities.Cells(i).Text
vntCities(k, 2) = rngCities.Cells(j).Text
Next
Next
With Worksheets("Entfernungen")
Set rngCities = .Range("A1").Resize(UBound(vntCities), UBound(vntCities, 2))
rngCities.Value = vntCities
End With
End Sub
..so in diese Richtung gehts.
|