Kopieren und einfügen von Zeilen basierend auf Werten in einer Spalte

Bin ich, die versuchen, ein Verfahren, das aussieht Zellen in Spalte "G" und wenn ein Wert größer als 1 ist, kopieren Sie die gesamte Tabelle Zeile eine Zeile einfügen (wie viele Male - 1 basierend auf dem Wert) und fügen Sie diesen Wert in jeder neu eingefügten Zeile.

Also, wenn es eine Menge von 3 in Zelle "G4", dann würde ich gern kopieren Sie die Zeile der Zelle, und fügen eine Zeile darunter dann 2 mal, und fügen Sie die kopierten Werte.

Unten ist das, was ich bisher...

**Hinweis: all dies ist in einer Tabelle in Excel. (nicht sicher, ob das Teil das Problem mit meinem code)

Dim Qty As Range

 For Each Qty In Range("G:G").cells
  If Qty.Value > 1 Then
   Qty.EntireRow.cell
   Selection.Copy
   ActiveCell.Offset(1).EntireRow.Insert
   Selection.Paste
   Selection.Font.Strikethrough = True

 End If

 Next

 End Sub

InformationsquelleAutor Ship72 | 2013-10-21

  1. 1

    Gibt es eine Reihe von Fragen mit Ihrem Ansatz und den code

    1. Sie sagen, dass die Daten in einer Excel-Tabelle. Verwenden Sie das zu Ihrem Vorteil
    2. Beim einfügen von Zeilen in einen Bereich der Schleife von unten nach oben. Dies verhindert, dass die eingefügten Zeilen sich mit den loop-index
    3. Nicht verwenden Selection (und selbst wenn Sie Ihre Logik nicht manipulieren, ActiveCell)
    4. Nicht Schleife über die ganze Spalte (das ist eine million Zeilen). Beschränken Sie die Größe der Tabelle

    Hier ist eine demonstration dieser Ideen 

    Sub Demo()
    Dim sh As Worksheet
    Dim lo As ListObject
    Dim rColumn As Range
    Dim i As Long
    Dim rws As Long

    Set sh = ActiveSheet ' <-- adjuct to suit
    Set lo = sh.ListObjects("YourColumnName")

    Set rColumn = lo.ListColumns("YourColumnName").DataBodyRange
    vTable = rColumn.Value

    For i = rColumn.Rows.Count To 1 Step -1
        If rColumn.Cells(i, 1) > 1 Then
            rws = rColumn.Cells(i, 1) - 1
            With rColumn.Rows(i)
                .Offset(1, 0).Resize(rws, 1).EntireRow.Insert
                .EntireRow.Copy .Offset(1, 0).Resize(rws, 1).EntireRow
                .Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
            End With
        End If
    Next
End Sub
    Funktionierte perfekt. Danke Chris
    Chris, Wenn ich wollte, ändern Sie die Anzahl der diejenigen, die neu hinzugefügten Zellen auf null, wie soll ich das tun?
    Nicht sicher, was du damit meinst qty - ist, dass eine Spalte mit überschrift?
    Ja QTY wäre die überschrift der Spalte. Seine Werte in der rColumn, wenn es fügt die neuen Zeilen und kopieren und fügt die Daten möchte ich die Anzahl der neuen Zeilen, die wiederum auf 0.
    QTY ist die Menge, basierend auf dem Wert das makro weiß, wie viele Male zu kopieren, dass bestimmte Zeile.

    InformationsquelleAutor chris neilsen

Schreibe einen Kommentar