Question

我正在编写VBA程序来搜索大型电子表格，并将具有相同帐户的行与数据相关联的行复制五次或更多次。当我单步执行每一行（F8）时，程序完全按照它应该执行的操作，但是当我运行程序（F5）时，它不会将任何信息复制到第二张表。我尝试在切换表格和粘贴数据之间添加两秒钟的延迟，以防这是问题，但到目前为止它还没有帮助。

有什么建议吗？

编辑：我认为屏幕更新可能导致问题，所以我禁用了它。该程序仍然没有将数据粘贴到另一个工作表中。

第二次编辑：我注意到当我在while循环开始时停止并按程序执行程序时，它也不会像应该那样复制和粘贴数据。但是，当单步执行代码时，它仍然有效。我也删除了2秒的暂停，因为那些没有什么区别。

以下是代码：

Public Sub Main()
Worksheets(2).Activate
Range("A1").Select
Worksheets(1).Activate
Range("C2").Select
AcctName = ActiveCell.Value
LoopControl = 0
AcctNameCt = 1
CurrentAcctRow = ActiveCell.Row

Do While LoopControl <> 1

    SecondLoopControl = 0
    If AcctName = ActiveCell.Offset(AcctNameCt, 0).Value Then
        AcctNameCt = AcctNameCt + 1
        If AcctNameCt > 4 Then
        GreaterThanFour
        End If
    ElseIf ActiveCell.Offset(AcctNameCt, 0).Value = "" Then
        Exit Do
    Else
        ActiveCell.Offset(AcctNameCt, 0).Activate
        AcctName = ActiveCell.Value
        AcctNameCt = 1
        CurrentAcctRow = ActiveCell.Row
    End If
Loop
End Sub

Public Sub CopyData()
    Dim EndRow As Integer
    Dim StopCopy As Integer
    Dim RestartRow As Integer
    EndRow = CurrentAcctRow + AcctNameCt
    StopCopy = EndRow - 1
    RestartRow = EndRow + 1
    ActiveSheet.Range("C" & CurrentAcctRow & ":" & "C" & StopCopy).EntireRow.Copy
    Worksheets(2).Activate
    LookForEmptyRow
    ActiveCell.EntireRow.PasteSpecial
    CurrentAcctRow = CurentAcctRow + 1
    Worksheets(1).Activate
    Range("C" & EndRow).Select
    AcctNameCt = 0

End Sub

Public Sub GreaterThanFour()
    Do While SecondLoopControl <> 1
        If AcctName = ActiveCell.Offset(AcctNameCt, 0).Value Then
            AcctNameCt = AcctNameCt + 1
        Else
            CopyData
            SecondLoopControl = 1
        End If
    Loop
End Sub

Public Sub LookForEmptyRow()
    Range("A1").Select
    Dim LookAnotherLoopControl As Integer
    LookAnotherLoopControl = 0
    Do While LookAnotherLoopControl <> 1
        If ActiveCell.Value = "" Then Exit Sub Else ActiveCell.Offset(1, 0).Activate
    Loop
End Sub

Answer 1

我将工作表名称设置为变量并调用它们，而不是直接调用工作表。出于某种原因，这样做效果更好。

 Set wbA = Workbooks(Workbook Name)
 Set wsA = Worksheets(Worksheet Name 1)
 Set wsB = Worksheets(Worksheet Name 2)

“工作簿名称”和“工作表名称1”反映实际名称的位置。那些工作比以下更好：

Worksheets(2).Activate
LookForEmptyRow
ActiveCell.EntireRow.PasteSpecial
CurrentAcctRow = CurentAcctRow + 1
Worksheets(1).Activate
Range("C" & EndRow).Select

我还使用了一种更好的方法来查找空行，而不是编写自己的子程序。原始代码有我写的这个子：

 Public Sub LookForEmptyRow()
    Range("A1").Select
    Dim LookAnotherLoopControl As Integer
    LookAnotherLoopControl = 0
    Do While LookAnotherLoopControl <> 1
        If ActiveCell.Value = "" Then Exit Sub Else ActiveCell.Offset(1, 0).Activate
    Loop

虽然有效，但效率极低。我用更有效的代码替换它：

lRow = Range("A1000").End(xlUp).Row
Cells(lRow + 1, 1).Activate

使用VBA

1 个答案: