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

Question

我有一个表，其中包含 A 列中的信息和 B 列中的适当值。我想编写一个宏，根据 B 列中的值为每个“人”插入一个新行，并将原始信息复制到该行中，例如，这意味着最后有 5 行“人 A”，2 行“人 B”等。

原表：

结果：

我的第一种方法看起来像那样。 它不起作用。

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

Answer 1

这对您有用，根据 B 列中的值更改插入次数：

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

首先，我们检查您是否正在处理数字。 其次，您已经有一行，所以数字-1 ，那么这个数字是>0 。 最后，您通过一个为您计数的循环插入。

---

测试数据：

Output 运行后：

Answer 2

你的指数计算搞砸了。 使用调试器，单步执行代码 (F8) 并注意发生了什么：

a) 您的 Select/Insert-construct 在您要复制的行上方创建一个新行，而不是在下方。
b) 索引k的计算失败：您没有初始化k ，因此它从值 0 开始。然后将j (1..3) 添加到 k，得到值 1、3、6，然后从该行复制数据.

我建议您采用不同的方法：将原始数据复制到一个数组中，然后遍历该数组。 这避免了多个 Select、Copy 和 Insert 语句（速度很慢），并允许从上到下复制数据。

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)
            Next col
            newRow = newRow + repeatCount
        Next
        
    End With
End Sub