Hallo,
hier eine neue angepasste Lösung:
Code:
Sub ordne_um_mit_verbundenen_Zellen2()
Dim i As Long, j As Long, k As Long
Dim lngZ As Long
Dim lngAnzahl As Long, lngEinheiten As Long
Dim strgAddressen As String
Dim varA, varZiel
With Sheets("Tabelle1")
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
varA = .Range("A6:K" & lngZ) 'Bereich, der eingelesen werden soll Hier A6:K bis letzte belegte Zeile in A
lngEinheiten = Application.Sum(.Range("D6:D" & lngZ))
End With
With Sheets("Tabelle3")
.Columns("D").MergeCells = False
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A2").Resize(lngZ - 1, UBound(varA, 2)).ClearContents
varZiel = .Range("A2").Resize(lngEinheiten, UBound(varA, 2))
For i = LBound(varA) To UBound(varA)
If varA(i, 4) > 1 Then strgAddressen = strgAddressen & ", " & .Range(.Cells(k + 2, 4), .Cells(k + varA(i, 4) + 1, 4)).Address
varZiel(k + 1, 4) = varA(i, 4)
For j = 1 To varA(i, 4)
For n = 1 To UBound(varA, 2)
varZiel(k + j, n) = varA(i, n)
If n = 3 Then n = n + 1
Next n
Next j
k = k + j - 1
Next i
strgAddressen = Mid(strgAddressen, 3)
.Range("A2").Resize(lngEinheiten, UBound(varA, 2)) = varZiel
.Range(strgAddressen).MergeCells = True
End With
End Sub
Im Code ist der eingelesene Bereich kenntlich gemacht. Dort gegebenenfalls anpassen.
Hallo atilla,
vielen Dank für den Code - das weitere übernehmen klappt wunderbar. Muss ich noch irgendetwas beachten, damit er die leeren Zellen mit übernimmt und diese nicht auffüllt?
Meine VBA-Kenntnisse sind leider noch nicht soweit ausgeprägt, dass ich den Code dementsprechend interpretieren kann.
Vielen Dank und einen schönen Abend.
Mit freundlichem Gruß
Bookshelf3011
(02.04.2017, 19:02)Bookshelf3011 schrieb: [ -> ]Muss ich noch irgendetwas beachten, damit er die leeren Zellen mit übernimmt und diese nicht auffüllt?
Hallo,
tut er das jetzt nicht?
Mit leeren Zellen ist doch gemeint, dass bei Wohneinheiten nichts steht.
Dann sollte mein zuletzt eingestellter Code das doch berücksichtigen.
Hallo atilla,
momentan ist es so, dass er die leeren Zeilen in der "Tabelle3" auffüllt, wenn in der Spalte Wohneinheiten kein Wert vorhanden ist.
Liegt es vielleicht daran, dass ich die Variable "n" definiert habe? VBA gibt mir diese nämlich als Fehlermeldung aus, wenn ich den Code ausführen will.
Ich habe "n" als "Long" definiert.
Könnte das der Grund sein?
Mit freundlichem Gruß
Bookshelf3011
Hallo,
mit n hast Du richtig gemacht.
Aber ich bin jetzt ein wenig durcheinander.
Kannst Du bitte am Beispiel erklären, was passiert und was nicht passiert aber passieren soll.
Hallo,
sehe gerade, dass ich den weiter korrigierten Code gar nicht eingestellt habe.
Sorry, ich dachte, dass ich ihn eingestellt hätte.
Hier ist er:
Code:
Sub ordne_um_mit_verbundenen_Zellen2()
Dim i As Long, j As Long, k As Long, n as Long
Dim lngZ As Long
Dim lngAnzahl As Long, lngEinheiten As Long
Dim strgAddressen As String
Dim varA, varZiel
With Sheets("Tabelle1")
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
varA = .Range("A6:K" & lngZ) 'Bereich, der eingelesen werden soll Hier A6:K bis letzte belegte Zeile in A
lngEinheiten = Application.Sum(.Range("D6:D" & lngZ))
If lngZ - 5 > Application.Count(.Range("D6:D" & lngZ)) Then
lngEinheiten = lngEinheiten + lngZ - 5 - Application.Count(.Range("D6:D" & lngZ))
End If
End With
With Sheets("Tabelle3")
.Columns("D").MergeCells = False
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A2").Resize(lngZ - 1, UBound(varA, 2)).ClearContents
varZiel = .Range("A2").Resize(lngEinheiten, UBound(varA, 2))
For i = LBound(varA) To UBound(varA)
If varA(i, 4) > 1 Then strgAddressen = strgAddressen & ", " & .Range(.Cells(k + 2, 4), .Cells(k + varA(i, 4) + 1, 4)).Address
varZiel(k + 1, 4) = varA(i, 4)
If varA(i, 4) = "" Then varA(i, 4) = 1
For j = 1 To varA(i, 4)
For n = 1 To UBound(varA, 2)
varZiel(k + j, n) = varA(i, n)
If n = 3 Then n = n + 1
Next n
Next j
k = k + j - 1
Next i
strgAddressen = Mid(strgAddressen, 3)
.Range("A2").Resize(lngEinheiten, UBound(varA, 2)) = varZiel
.Range(strgAddressen).MergeCells = True
End With
End Sub
Guten Abend atilla,
ich hoffe es stört dich nicht, dass ich Screenshots zur besseren Erklärung mit beigefügt habe...
Momentan erhalte ich - sofern die Zelle Wohneinheiten leer ist - den Laufzeitfehler '9'.
Im vorherigen Code gab er mir das Ergebnis aus dem zweiten Screenshot ("Screenshot B") wieder.
[
attachment=10558]
[
attachment=10559]
[
attachment=10560]
Vielen Dank für deine Mühen und einen schönen Sonntagabend.
Mit freundlichem Gruß
Bookshelf3011
Hallo,
ok, ich ging davon aus, dass in WE nicht steht, aber es sind ganze leere Zeilen dazwischen.
Warum???
Lösch sie, das ist ganz einfach. Kopier die Tabelle im Ganzen und lösch die leeren Zeilen und führ den Code dann aus.
Das kann ich, bei bedarf auch einarbeiten.
Ich kann aber auch im bestehenden Code die leeren Zeilen berücksichtigen. Dazu müsste ich noch wissen, ob in WE immer eine Zahl steht.
Hallo atilla,
sry, da habe ich mich wohl missverständlich ausgedrückt. Aber um deine Frage zu beantworten:
Ja, in WE steht immer eine Zahl.
Mit freundlichem Gruß
Bookshelf3011
Hallo,
der zueltzt eingestellte Code sollte das machen, was Du möchtest.
Bei mir sieht die Quelle so aus:
| Arbeitsblatt mit dem Namen 'Tabelle1' |
| | A | B | C | D | E | F | G | H | I | J | K |
| 5 | Straße | Hausnummer | Zusatz | Wohneinheiten | | | | | | | |
| 6 | Musterstraße | 3 | | 1 | e1 | f1 | g1 | h1 | i1 | j1 | k1 |
| 7 | Musterstraße | 17 | a | 3 | e2 | f2 | g2 | h2 | i2 | j2 | k2 |
| 8 | | | | | | | | | | | |
| 9 | Musterstraße | 9 | | 1 | e3 | f3 | g3 | h3 | i3 | j3 | k3 |
| 10 | Musterstraße | 8 | a | 2 | e4 | f4 | g4 | h4 | i4 | j4 | k4 |
| 11 | | | | | | | | | | | |
| 12 | Musterstraße | 8 | | 2 | e5 | f5 | g5 | h5 | i5 | j5 | k5 |
| 13 | Musterstraße | 7 | | 1 | e6 | f6 | g6 | h6 | i6 | j6 | k6 |
| Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg |
und nach Codeausführung in Tabelle3 so:
| Arbeitsblatt mit dem Namen 'Tabelle3' |
| | A | B | C | D | E | F | G | H | I | J | K |
| 1 | Straße | Hausnummer | zusatz | wohneinheiten | Bemerkunge | | | | | | |
| 2 | Musterstraße | 3 | | 1 | e1 | f1 | g1 | h1 | i1 | j1 | k1 |
| 3 | Musterstraße | 17 | a | 3 | e2 | f2 | g2 | h2 | i2 | j2 | k2 |
| 4 | Musterstraße | 17 | a | e2 | f2 | g2 | h2 | i2 | j2 | k2 |
| 5 | Musterstraße | 17 | a | e2 | f2 | g2 | h2 | i2 | j2 | k2 |
| 6 | | | | | | | | | | | |
| 7 | Musterstraße | 9 | | 1 | e3 | f3 | g3 | h3 | i3 | j3 | k3 |
| 8 | Musterstraße | 8 | a | 2 | e4 | f4 | g4 | h4 | i4 | j4 | k4 |
| 9 | Musterstraße | 8 | a | e4 | f4 | g4 | h4 | i4 | j4 | k4 |
| 10 | | | | | | | | | | | |
| 11 | Musterstraße | 8 | | 2 | e5 | f5 | g5 | h5 | i5 | j5 | k5 |
| 12 | Musterstraße | 8 | | e5 | f5 | g5 | h5 | i5 | j5 | k5 |
| 13 | Musterstraße | 7 | | 1 | e6 | f6 | g6 | h6 | i6 | j6 | k6 |
| Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg |