Hy! :19:
Ich möchte jede Zeile einer Excel file so oft duplizieren wie in Zellen steht. Am besten lässt sich das bildlich darstellen glaube ich.
Siehe Bild:
Zeile 1 wird also 1x dupliziert weil Spalte 1 (grün) und dann noch 2x weil Spalte 5 (gelb).
Zeile 2 wird insgesamt 4x dupliziert.
Es sollen in allen Zellen am Ende nur noch Einsen stehen.
Ich habe folgenden Thread gefunden, der sich mit einem ähnlichen Thema befasst:
herber.de -> Zeilen so oft duplizieren wie in Zellen steht
Das Skript ist mir aber zu kompliziert. Außerdem habe ich mehrere Zellen nach denen dupliziert werden soll.
Ich suche nach einem einfachen Lösungsansatz denn ich bin bei Gott kein Excel Profi :19: :19:
Bin Euch für jede Hilfe dankbar!!
Liebe Grüße
Maren
Hallo
so??
Code:
Sub Kopieren()
Dim i As Long, j As Integer, LR As Long, LC As Integer
Dim Z1 As Integer, SP As Integer, S1 As Integer
Dim Anz As Integer, mmax As Integer
SP = 1
S1 = 2 'Ab Spalte B
Z1 = 2 'ab Zeile 2
LR = Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
LC = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
For i = LR To Z1 Step -1
mmax = WorksheetFunction.Max(Cells(i, S1).Resize(1, LC - S1 + 1))
Rows(i).Copy
Rows(i + 1).Resize(mmax - 1).Insert xlDown
For j = S1 To LC
Anz = Cells(i, j)
If Anz > 0 Then
Cells(i, j).Resize(Anz, 1) = 1
If Anz < mmax Then
Cells(i, j).Offset(Anz, 0).Resize(mmax - Anz, 1) = 0
End If
End If
Next
Next
Application.CutCopyMode = False
End Sub
LG UweD
@UweD: Wow Danke!
Das übersteigt meine Excel Kentnisse bei weitem.
Ich konnte herausfinden, dass dieser Code in Microsoft Visual Basics for Applications eingefügt gehört. (Stimmt das??) Dieses öffne ich wiederum mit STRG+F11 (siehe Bild). Das wars dann aber auch; ich weiß leider überhaupt nicht was ich da tue! Hilfeee! :22:
Hallo
Wenn du im VBA -Editor bist (in Excel Alt und F11) dann "Einfügen", "Modul".
Dort dann den Code reinkopieren
Dann kannst du in Excel z.B. einen Button einfügen und das Makro damit verknüpfen
- Das Makro arbeitet von unten nach oben. (von der Letzten zur 2. Zeile)
- Es fügt die maximale Anzahl an Zeilen (-1) unter der jeweiligen Zeile ein
- Dann wird je Spalte geprüft, ob >0 und die entsprechenden Werte in der Spalte werden auf 1 gesetzt
- Mögliche restliche Zeilen darunter erhalten in der Spalte eine 0
LG UweD
Wofür brauchst du das ?
Bitte, lade Excel-Dateien hoch, keine Bilder !
OK soweit. Es zeigt mir allerdings einen Fehler an (siehe Anhang).
Wie snb schon geschrieben hat.
Bitte Datei, keine Fotos
Hallo,
auf dem Bild ist nur die Zeile zu sehen, die den Fehler verursacht - nicht aber der Fehler. Man könnte vermuten, dass in der betreffenden Zeile nix steht oder nur in Spalte A etwas ...
Du hast unten im VBA-Editor einige Fenster, u.a. Überwachung. Gehe dort mit der Maus rein und füge Überprüfungen der einzelnen Variablen hinzu. Eventuell ergibt diese Berechnung
LC - S1 + 1
Null als Ergebnis ...
Code:
Sub M_snb()
sn = Sheet1.Cells(1).CurrentRegion
sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2) = " "
For j = 2 To UBound(sn)
sheet1.Cells(1).CurrentRegion.Rows(j).Copy sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Application.Max(Application.Index(sn, j)))
Next
End Sub