Question

我有以下代码：

Private Sub Update_To_Search_Click()
'add the user id and date in the lock and date columns
Dim r As Range
Dim wb As Workbook
 Set wb = Workbooks("GOOD")
 Set r = ActiveCell
 For i = 1 To Rows.count
     Set r = r.Offset(1, 0)
     If r.EntireRow.Hidden = False Then
         r.Select
         GoTo Continue
     End If
 Next

Continue:
ActiveCell.Offset(0, 67).Select
If ActiveCell.Value = "" Then
    ActiveCell.Value = UCase(Environ("UserName"))
    ActiveCell.Offset(0, 1).Value = Now
    ActiveCell.EntireRow.Select
    Selection.Copy
    wb.Activate
    Sheets("GoodDBData").Select
    Range("A2").Select
    ActiveSheet.Paste

Else
    ActiveCell.EntireRow.Select
    Selection.Copy
    wb.Activate
    Sheets("GoodDBData").Select
    Range("A2").Select
    ActiveSheet.Paste
End If
End sub

运行时，它保持旋转状态[无响应]。我已经使用粘贴编码很多次了，以前从未发生过。

知道为什么吗？谢谢

Answer 1

Avoid using .Select/.Activate。此外，通常不赞成使用GoTo。

此外，您很可能实际上不想遍历Excel中的每一行。这可能导致它挂断/出错。

此代码应该可以工作，我想我按照您的意图保留了它：

Private Sub Update_To_Search_Click()
'add the user id and date in the lock and date columns
Dim r       As Range
Dim wb      As Workbook
Set wb = Workbooks("GOOD")
Set r = wb.Worksheets("Sheet1").Range("A1")       ' CHANGE THIS WORKSHEET to the correct name, and update the starting cell!!!!!!!
For i = 1 To wb.Worksheets("Sheet1").Cells(rows.count,1).End(xlUp).Row ' Change this to the column with the most data
    Set r = r.Offset(1, 0)
    If r.EntireRow.Hidden = False Then
        If r.Offset(0, 67).Value = "" Then
            r.Offset(0, 67).Value = UCase(Environ("UserName"))
            r.Offset(0, 67).Offset(0, 1).Value = Now
            r.Offset(0, 67).EntireRow.Copy wb.Sheets("GoodDBData").Range("A2").Paste
        Else
            r.EntireRow.Copy
            wb.Sheets("GoodDBData").Range("A2").Paste
        End If
    End If
Next
Application.CutCopyMode = False
End Sub

复制粘贴使VBA崩溃

1 个答案: