Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1780to1784
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeile kopieren und runterzählen

Zeile kopieren und runterzählen
23.09.2020 09:54:39
Simon
Hallo Zusammen
Ich suche eine Lösung für folgende Aufgabe:
Ausgangslage:
Excel mit vier Spalten und einer varaiblen Anzahl Zeilen.
In der Spalte B ist eine Mengenanbagen, in den Spalten A, C und D sind Informationen als Zahlen oder Buchstaben.
Ziel:
Ist die Mengeangabe der Zelle in der Spalte B grösser 1, so soll die Zeile kopiert und unten an die Tabelle angeführt werden. Dabei soll in der neuen Zeile den Spaltenwert B die Menge 1 haben und bei der Ausgangszeile soll der Zellenwert der Spalte B um 1 veringert werden.
Dies soll wieder holt werden, bis die Ausgangszeile der Zellenwert in Spalte B = 1 ist, anschliessend zur nächsten Zeile weiter und das Ganze wiederholen.
Beispiel:
Ausgangswerte:






  Spalte A  Spalte B  Spalte C  Spalte D
Zeile 1  6203N  4  Inventar  Info
Zeile 2  5777N  2  16762  Info
Zeile 3  5777R  1  16801  Info
Zeile 4  8504R 3  16810  Info

Zielwerte:











    Spalte A  Spalte B  Spalte C  Spalte D
Zeile 1  6203N  1  Inventar  Info
Zeile 2  5777N 1  16762  Info
Zeile 3  5777R  1  16801  Info
Zeile 4  8504R  1  16810  Info
Zeile 5  6203N  1  Inventar  Info
Zeile 6  6203N  1  Inventar  Info
Zeile 7  6203N  1  Inventar  Info
Zeile 8  5777N  1  16762  Info
Zeile 9  8504R  1  16810  Info
Zeile 10  8504R  1  16810 Info

Ich hoffe die Problemstellung verständlich notiert zu haben und bin euch für eure VBA-Lösungen bereits jetzt unheimlich dankbar.
Liebe Grüsse
Simon

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeile kopieren und runterzählen
23.09.2020 10:16:27
Rudi
Hallo,
Sub aaa()
Dim arrOUT(), arrIn
Dim lngIndex As Long, i As Integer, n As Long
ReDim arrOUT(1 To WorksheetFunction.Sum(Columns(2)), 1 To 4)
arrIn = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Resize(, 4)
For lngIndex = 1 To UBound(arrIn)
For i = 1 To arrIn(lngIndex, 2)
n = n + 1
arrOUT(n, 1) = arrIn(lngIndex, 1)
arrOUT(n, 2) = 1
arrOUT(n, 3) = arrIn(lngIndex, 3)
arrOUT(n, 4) = arrIn(lngIndex, 4)
Next i
Next lngIndex
Cells(1, 1).Resize(UBound(arrOUT), 4) = arrOUT
End Sub

Gruß
Rudi
AW: Zeile kopieren und runterzählen
24.09.2020 10:55:38
Simon
Vielen herzlichen Dank!
Das hat mir bereits sehr geholfen. :-)
Grüsse
Simon
Anzeige
AW: Zeile kopieren und runterzählen
23.09.2020 10:18:09
Reinhold
Do Until Cells(i,2) <> ""
lZeile=Cells(i,2).End(xlDown).Offset(1,0).Row
If Cells(i,2).Value>1 Then
Wert=Cells(i,2).Value
For Wert=Wert to 1 Step -1
Cells(lZeile,1).Value=Cells(i,1).Value
Cells(lZeile,2).Value=1
Cells(lZeile,3).Value=Cells(i,3).Value
Cells(lZeile,3).Value=Cells(i,4).Value
lZeile=lZeile+1
next
End if
Cells(i,2).Value=1
i=i+1
Loop
So in etwa?
Wenns natürlich wesentlich mehr Zeilen sind bzw. Spalten, dann würde ich gleich die ganze Zeile kopieren, bzw. mit Arrays arbeiten

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige