Excel VBA --根据单元格中的值添加行。开发者社区

link之家

链接快照平台

输入网页链接，自动生成快照
标签化管理网页链接

文章/答案/技术大牛

发布

Dim i, j, k As Integer
For i = Range("A" & Range("A:A").Rows.Count).End(xlUp).Row To 1 Step -1
        For j = 1 To Range("B" & i)
            Rows(i).Select
            Selection.Insert Shift:=xlDown
            k = k + j
            Range(Cells(k, 1), Cells(k, 2)).Copy Destination:=Range("A" & i)
        Next j
Next i

Option Explicit
Sub test()
    With Sheets(1)
        Dim lastRow As Long:  lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim i As Long
        For i = lastRow To 1 Step -1
            If IsNumeric(.Cells(i, 2).Value) = True Then
                Dim numberOfInserts As Long
                numberOfInserts = .Cells(i, 2).Value - 1
                If numberOfInserts > 0 Then
                    Dim insertCount As Long
                    For insertCount = 1 To numberOfInserts
                        .Rows(i).Copy
                        .Rows(i).Insert
                    Next insertCount
                End If
            End If
        Next i
    End With
End Sub

Sub copy()
    Dim rowCount As Long
    Dim data As Variant
    With ActiveSheet    ' Replace with the sheet you want to work with
        ' Copy the current table into array
        rowCount = .Cells(.Rows.Count, 1).End(xlUp).row
        data = .Range(.Cells(1, 1), .Cells(rowCount, 2))
        Dim oldRow As Long, newRow As Long
        newRow = 1
        ' Loop over old data
        For oldRow = 1 To rowCount
            Dim repeatCount As Long
            repeatCount = Val(data(oldRow, 2)) ' We want to have so many occurrences of the row
            if repeatCount <= 0 Then repeatCount=1
            Dim col As Long
            ' Create "repeatCount" rows of data (copy column by column)
            For col = 1 To 2
                .Cells(newRow, col).Resize(repeatCount, 1) = data(oldRow, col)

问 Excel VBA --根据单元格中的值添加行。 EN

回答 2

Stack Overflow用户

Stack Overflow用户