英文:
Insert blank row based on cell value - 1
问题
在列R中有数字（有时一张表上有4行，有时超过1000行），需要在任何列R中的值大于1的行下面添加空白行。
第2行列R的值为1，因此不需要添加空行。第3行列R的值为3，因此需要在其下添加2个空白行。第4行列R的值为2，因此需要在其下添加1个空白行，依此类推。
我在这里找到了这段代码，它曾经有效，但现在不再有效：
Sub Main()
'---变量---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---自定义---
Set source = ThisWorkbook.Sheets(1) '包含数据的工作表
startRow = 2 '包含数据的第一行
'---逻辑---
i = startRow 'i作为行计数器
Do While i <= source.Range("O" & source.Rows.Count).End(xlUp).Row
'循环直到我们到达列E中的最后一个带值的行
num = source.Range("R" & i).Value '获取出现次数
val = source.Range("A" & i).Value '获取值
If num > 1 Then '出现次数大于1
Do While num > 1 '创建行
source.Range("A" & i + 1).EntireRow.Insert '插入行
num = num - 1
i = i + 1 '下一行
Loop
End If
i = i + 1 '下一行
Loop
End Sub
希望这对你有帮助。
英文:
I have numbers in col R (sometimes there are 4 lines on a sheet, other times over 1000), and need to add blank rows beneath any row that has more than the value 1 in column R.
Row 2 has value of 1 in column R so no blanks are needed, Row 3 has value of 3, so I need to add 2 blank rows below it. Row 4 has value of 2 so I need to add 1 blank row below, etc.
I found this code on here and it was working but now it is not:
`Sub Main()
'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data
'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("O" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
num = source.Range("R" & i).Value 'Get number of appearances
val = source.Range("A" & i).Value 'Get the value
If num > 1 Then 'Number of appearances > 1
Do While num > 1 'Create rows
source.Range("A" & i + 1).EntireRow.Insert 'Insert row
num = num - 1
i = i + 1 'Next row
Loop
End If
i = i + 1 'Next row
Loop
End Sub`
</details>
# 答案1
**得分**: 1
在插入行时，从底部到顶部更容易。例如：
```lang-vb
Sub Main()
Dim source As Worksheet, num As Long, c As Range
With ThisWorkbook.Sheets(1) '数据所在的工作表
'从ColO中的最后一个占用行的ColR开始
Set c = .Cells(.Cells(.Rows.Count, "O").End(xlUp).Row, "R")
Debug.Print "从 " & c.Address & " 开始在 '" & .Name & "' 上"
End With
Do While c.Row > 1
num = c.Value '获取出现次数
If num > 1 Then
c.Offset(1).Resize(num - 1).EntireRow.Insert shift:=xlShiftDown
End If
Set c = c.Offset(-1)
Loop
End Sub
请注意，上面的代码已经被翻译成中文。如果您需要进一步的帮助或有其他翻译需求，请随时告诉我。
英文:
When inserting rows it's easier to work from the bottom to the top. For example:
Sub Main()
Dim source As Worksheet, num As Long, c As Range
With ThisWorkbook.Sheets(1) 'The sheet with the data
'start in ColR, at last-occupied row in ColO
Set c = .Cells(.Cells(.Rows.Count, "O").End(xlUp).Row, "R")
Debug.Print "Starting at " & c.Address & " on '" & .Name & "'"
End With
Do While c.Row > 1
num = c.Value 'Get number of appearances
If num > 1 Then
c.Offset(1).Resize(num - 1).EntireRow.Insert shift:=xlShiftDown
End If
Set c = c.Offset(-1)
Loop
End Sub
答案2
得分: 0
你可能需要将语句中的 O 改为 R：
在这段代码中，它确定了循环中将要处理的最后一行。如果在列 `O` 中没有数据，那么什么都不会处理。
英文:
Probably you need to change O to R in the statement:
Do While i <= source.Range("O" & source.Rows.Count).End(xlUp).Row
This code determines last row that will be processed in the loop. If there is no data in the column O - nothing is processed.
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论