Excel VBA --根据单元格中的值添加行。
Excel VBA --根据单元格中的值添加行。
提问于 2022-11-21 15:37:19
我有一个表，表中有A列的信息，B列有适当的值。我想编写一个宏，根据B列中的值为每个"Person“插入一个新行，并将原始信息复制到该行中，例如，这意味着最后有5行带有"Person A"，2行表示"Person 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回答 2
Stack Overflow用户
回答已采纳
发布于 2022-11-21 15:53:18
这将适用于您，根据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。最后，您通过一个循环插入，该循环为您进行计数。
测试数据：
运行后输出：
Stack Overflow用户
发布于 2022-11-21 16:28:48
你的索引计算搞砸了。使用调试器，通过代码(F8)执行步骤，并注意发生了什么：
( a)选择/插入-构造会在要复制的行之上创建一个新行，而不是在下面。
b)索引k的计算失败:您没有初始化k，因此它以值0开头。而不是将j ( 1 .. 3 )添加到k中，从而得到值1、3、6，并从该行复制数据。
我建议您采取一种不同的方法:将原始数据复制到数组中，然后遍历该数组。这避免了多次选择、复制和插入语句(慢)，并允许从上到下复制数据。
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/74521356
复制相关文章
相似问题
腾讯云开发者
