Zeilen so oft duplizieren wie in Zellen steht

[Maren90]

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

[UweD]

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

[Maren90]

@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:

[UweD]

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

[snb]

Wofür brauchst du das ?

Bitte, lade Excel-Dateien hoch, keine Bilder !

[Maren90]

OK soweit. Es zeigt mir allerdings einen Fehler an (siehe Anhang).

[UweD]

Wie snb schon geschrieben hat.

Bitte Datei, keine Fotos

[schauan]

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 ...

[snb]

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