英文:
I have to run my code several times for it to execute entirely
问题
I'm not sure whether it's because I'm using a mac or the code is wrong, but the rows aren't identifying properly, and therefore not deleting or pasting it into the other spreadsheet. I have to run the code three times for it to properly go through it and copy/paste and delete the cells into the other spreadsheet.
Many thanks!
here is the code:
Dim j, lastidno As Long
Sheets("Part B + C Modules").Activate
lastidno = Range("A2", Range("A2").End(xlDown)).Count + 1
For j = 2 To lastidno
If Range("O" & j) = "" Then
Sheets("Part B + C Modules").Range("A" & j).Copy
Sheets("No Options Selected").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Part B + C Modules").Activate
Rows(j).EntireRow.Delete
End If
Next
MsgBox "done"
End Sub```
<details>
<summary>英文:</summary>
I'm not sure whether it's because I'm using a mac or the code is wrong, but the rows aren't identifying properly, and therefore not deleting or pasting it into the other spreadsheet. I have to run the code three times for it to properly go through it and copy/paste and delete the cells into the other spreadsheet.
Many thanks!
here is the code:
```Sub trial()
Dim j, lastidno As Long
Sheets("Part B + C Modules").Activate
lastidno = Range("A2", Range("A2").End(xlDown)).Count + 1
For j = 2 To lastidno
If Range("O" & j) = "" Then
Sheets("Part B + C Modules").Range("A" & j).Copy
Sheets("No Options Selected").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Part B + C Modules").Activate
Rows(j).EntireRow.Delete
End If
Next
MsgBox "done"
End Sub
</details>
# 答案1
**得分**: 0
使用负的`Step`来进行迭代和删除行，即`For j = lastidno to 2 Step -1`。
然而，似乎你可以更加优雅地重写你的代码以避免：
* 隐式的`Range`引用
* 迭代
* 使用`Activate`或`Select`
关键在于要有`明确`的工作表引用以进行操作。此外，`SpecialCells`的使用在这里可以派上用场，可以一次返回一个`Range`（因此不再需要迭代）。这样你也可以一次性删除所有行！
例如，你的代码可以像这样：
```vba
Sub Test()
'设置工作表变量
Dim ws1 As Worksheet: Set ws1 = Worksheets("Part B + C Modules")
Dim ws2 As Worksheet: Set ws2 = Worksheets("No Options Selected")
'获取最后使用的行
Dim lr1 As Long: lr1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
Dim lr2 As Long: lr2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
'设置范围并复制它
Dim rng As Range: Set rng = ws1.Range("O2:O" & lr1).SpecialCells(xlCellTypeBlanks).Offset(0, -14)
rng.Copy ws2.Cells(lr2 + 1, 1)
'删除范围
rng.EntireRow.Delete
MsgBox "完成"
End Sub
小提示：当找不到空单元格时，SpecialCells会返回错误。你可以使用On Error或首先计算你的Range中的空单元格数量来解决这个问题（我个人的偏好）。所以特定部分可以看起来像这样：
'设置范围并复制它
If WorksheetFunction.CountBlank(ws1.Range("O2:O" & lr1)) > 0 Then
Dim rng As Range: Set rng = ws1.Range("O2:O" & lr1).SpecialCells(xlCellTypeBlanks).Offset(0, -14)
rng.Copy ws2.Cells(lr2 + 1, 1)
End If
未来参考的一个小提示：Dim j, lastidno As Long 只有lastidno 声明为Long数据类型。j 变量被自动分配为Variant/Integer，因此当你的数据大于这个数据类型可以容纳的范围时，可能会出现问题，导致Overflow错误。
英文:
Iteration and deleting rows goes backwards using a negative Step > For j = lastidno to 2 Step -1
However, it appears you could rewrite your code a bit more elegantly to avoid:
- Implicit
Rangereferences - Iteration
- Use of
ActivateorSelect
The key is to have Explicit sheet references to work with. Also the use of SpecialCells can come in handy here to return a Range in one go (so no more iteration). This way you can also delete all rows in one go!
You code could, for example, look like:
Sub Test()
'Set up your worksheet variables
Dim ws1 As Worksheet: Set ws1 = Worksheets("Part B + C Modules")
Dim ws2 As Worksheet: Set ws2 = Worksheets("No Options Selected")
'Get last used rows
Dim lr1 As Long: lr1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
Dim lr2 As Long: lr2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
'Set your range and copy it
Dim rng As Range: Set rng = ws1.Range("O2:O" & lr1).SpecialCells(xlCellTypeBlanks).Offset(0, -14)
rng.Copy ws2.Cells(lr2 + 1, 1)
'Delete your range
rng.EntireRow.Delete
MsgBox "done"
End Sub
Small catch: SpecialCells will return an error when no empty cells are found. You might want to work your way around that using On error or count the empty cells in your Range first (my personal preference). So that specific part could looke like:
'Set your range and copy it
If WorksheetFunction.CountBlank(ws1.Range("O2:O" & lr1)) > 0 Then
Dim rng As Range: Set rng = ws1.Range("O2:O" & lr1).SpecialCells(xlCellTypeBlanks).Offset(0, -14)
rng.Copy ws2.Cells(lr2 + 1, 1)
End If
Another small note for future reference: Dim j, lastidno As Long only has lastidno declared as Long data type. j Variable is auto-assigned to Variant/Integer so could potentially become a problem when your data is larger than this data type can hold > Return an OverFlow error.
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论