Straßenliste mit Hausnummern umformatieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Vervielfaeltigen() Dim WkSh_E As Worksheet Dim WkSh_A As Worksheet Dim lZeile_E As Long Dim lZeile_A As Long Dim vTemp As Variant Dim iTemp As Integer Set WkSh_E = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattname ggf. anpassen Set WkSh_A = ThisWorkbook.Worksheets("Tabelle2") ' den Tabellenblattname ggf. anpassen With WkSh_E For lZeile_E = 2 To WkSh_E.Cells(WkSh_E.Rows.Count, 1).End(xlUp).Row With WkSh_A lZeile_A = WkSh_A.Cells(WkSh_A.Rows.Count, 1).End(xlUp).Row If lZeile_A "" Then vTemp = Split(WkSh_E.Range("B" & lZeile_E).Value, ",") For iTemp = LBound(vTemp) To UBound(vTemp) WkSh_A.Range("A" & lZeile_A).Value = WkSh_E.Range("A" & lZeile_E).Value WkSh_A.Range("B" & lZeile_A).Value = vTemp(iTemp) lZeile_A = lZeile_A + 1 Next iTemp Else WkSh_A.Range("A" & lZeile_A).Value = WkSh_E.Range("A" & lZeile_E).Value lZeile_A = lZeile_A + 1 End If End With Next lZeile_E End With End Sub

Option Explicit Public Sub Vervielfaeltigen() Dim WkSh_E As Worksheet Dim WkSh_A As Worksheet Dim lZeile_E As Long Dim lZeile_A As Long Dim vTemp As Variant Dim iTemp As Integer Set WkSh_E = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattname ggf. anpassen Set WkSh_A = ThisWorkbook.Worksheets("Tabelle2") ' den Tabellenblattname ggf. anpassen WkSh_A.Range("A2:B" & WkSh_A.Cells(WkSh_A.Rows.Count, 1).End(xlUp).Row).ClearContents With WkSh_E For lZeile_E = 2 To WkSh_E.Cells(WkSh_E.Rows.Count, 1).End(xlUp).Row 'If lZeile_E = 4 Then Stop With WkSh_A lZeile_A = WkSh_A.Cells(WkSh_A.Rows.Count, 1).End(xlUp).Row + 1 If lZeile_A "" Then vTemp = Split(WkSh_E.Range("B" & lZeile_E).Value, ",") For iTemp = LBound(vTemp) To UBound(vTemp) WkSh_A.Range("A" & lZeile_A).Value = WkSh_E.Range("A" & lZeile_E).Value WkSh_A.Range("B" & lZeile_A).Value = vTemp(iTemp) lZeile_A = lZeile_A + 1 Next iTemp Else WkSh_A.Range("A" & lZeile_A).Value = WkSh_E.Range("A" & lZeile_E).Value lZeile_A = lZeile_A + 1 End If End With Next lZeile_E End With End Sub

Hallo Andy,
Version etwas bereinigt und mit etwas Dokumentation versehen

Option Explicit
Public Sub Vervielfaeltigen()
Dim WkSh_E    As Worksheet ' Eingabe Tabellenblatt
Dim WkSh_A    As Worksheet ' Ausgabe Tabellenblatt
Dim lZeile_E  As Long      ' Zeile des Eingabe-Blattes
Dim lZeile_A  As Long      ' Zeile des Ausgabe-Blattes
Dim vTemp     As Variant   ' Array zur Aufnahme der Hausnummern
Dim iTemp     As Integer   ' Index zum Array
Set WkSh_E = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattname ggf. anpassen
Set WkSh_A = ThisWorkbook.Worksheets("Tabelle2") ' den Tabellenblattname ggf. anpassen
WkSh_A.Range("A1").Value = "Straße"
WkSh_A.Range("B1").Value = "Hausnummer"
WkSh_A.Range("A2:B" & WkSh_A.Cells(WkSh_A.Rows.Count, 1).End(xlUp).Row).ClearContents
For lZeile_E = 2 To WkSh_E.Cells(WkSh_E.Rows.Count, 1).End(xlUp).Row
lZeile_A = WkSh_A.Cells(WkSh_A.Rows.Count, 1).End(xlUp).Row + 1
If lZeile_A  "" Then
vTemp = Split(WkSh_E.Range("B" & lZeile_E).Value, ",")
For iTemp = LBound(vTemp) To UBound(vTemp)
WkSh_A.Range("A" & lZeile_A).Value = WkSh_E.Range("A" & lZeile_E).Value
WkSh_A.Range("B" & lZeile_A).Value = Trim$(vTemp(iTemp))
lZeile_A = lZeile_A + 1
Next iTemp
Else
WkSh_A.Range("A" & lZeile_A).Value = WkSh_E.Range("A" & lZeile_E).Value
lZeile_A = lZeile_A + 1
End If
Next lZeile_E
End Sub

Gruß Peter

Beliebteste Forumthreads (12 Monate)

Straßenliste mit Hausnummern umformatieren

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Straßenliste mit Hausnummern umformatieren

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread