Question

我希望我的宏根据一个单元格中的datediff值选择特定的数据选择，然后将其复制并粘贴到另一个工作表中。它做到了这一点，但它不停地来回闪烁，给人一种毛刺/波涛汹涌的外观。有关如何修复它的任何提示/想法？

Sub Invoice()

Dim s As Integer
s = 2

Dim t As Integer
t = 21

Dim Newbook As Workbook
Set Newbook = Workbooks.Add
Workbooks("Workbook2.xlsm").Sheets("Invoice Template (2)").Copy     Before:=Newbook.Sheets(1)
    ActiveSheet.Name = "Current Invoice"

Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

Do Until IsEmpty(Cells(s, 1))
mini = Cells(s, 21).Value 'The datediff value I want to find'
If mini = "2" Then

Cells(s, 10).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 2).Row
Cells(Nextrow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

Cells(s, 8).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 3).Row
Cells(Nextrow, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate


Cells(s, 11).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 7).Row
Cells(Nextrow, 7).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

'Calulating the Premium'
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
If Cells(s, 9) = 1001 Then  'Formula for Life, AD & D, ASI, CI'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 1000
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1103 Then  'Formula for LTD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 100
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1104 Then  'Formula for STD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 10
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 2112 Then  'General Formula'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = Cells(t, 2) * Cells(t, 7)
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
End If


'Calculating Commission'

Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
If Cells(s, 15) = 5501 Then
'Add Commission schedule for ACE AND AIG'
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 15) = 5514 Then
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(18, 4) = 0.06 'Commission Rate'
    Cells(38, 8) = 0.9  'Front-Load Payment'
    Cells(39, 8) = 0.1  'Hold Back Amount'
 Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
End If


'Business and Insurer Information'

    'Insurer Name'
    Cells(s, 14).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(8, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Insurer Address'
    Cells(s, 16).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(9, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate


    'Insert Solution for City, Province, Postal Code'

    'Client Name'
    Cells(s, 3).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(13, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Client Address'
    Cells(s, 4).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(14, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Insert Solution for City, Province, Postal Code'
    Cells(s, 1).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(10, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Renewal Date'
    Cells(s, 22).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(11, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    'Anniversary Date'
    Cells(s, 20).Copy
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Cells(12, 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

    Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
t = t + 1



End If


s = s + 1
Loop

Newbook.Activate

Dim Client As String
Client = Cells(13, 2).Value

    Dim Presently As String
    Presently = " - " & MonthName(Month(Date)) & " " & Year(Date)
    'ActiveWorkbook.SaveAs Filename:=Client & "Invoice" & Presently'

End Sub

Answer 1

您可以像这样简化所有代码块：

Cells(s, 10).Copy
Newbook.Activate
Newbook.Sheets("Current Invoice").Select
Nextrow = Cells(t, 2).Row
Cells(Nextrow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

取而代之的是（所有三个块，简化为此）：

Newbook.Sheets("Current Invoice").Cells(t, 2).Value = Cells(s, 10).Value

Newbook.Sheets("Current Invoice").Cells(t, 3).Value = Cells(s, 8).Value

Newbook.Sheets("Current Invoice").Cells(t, 7).Value = Cells(s, 11).Value

您还可以简化所有这些：

If Cells(s, 9) = 1001 Then  'Formula for Life, AD & D, ASI, CI'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 1000
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1103 Then  'Formula for LTD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 100
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 1104 Then  'Formula for STD'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = (Cells(t, 2) * Cells(t, 7)) / 10
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate

ElseIf Cells(s, 9) = 2112 Then  'General Formula'
    Newbook.Activate
    Newbook.Sheets("Current Invoice").Select
    Prem = Cells(t, 2) * Cells(t, 7)
    Cells(t, 9).Value = Prem
Workbooks("Workbook2.xlsm").Sheets("Sheet1").Activate
End If

对此：

Dim wsInvoice as Worksheet
Set wsInvoice = Newbook.Sheets("Current Invoice")  'You could move these lines the the 
                                                   ' beginning of your code and replace
                                                   ' all references to NewBook.Sheets("CurrentInvoice") with wsInvoice 


With wsInvoice
Select Case Cells(s, 9)
    Case 1001  'Formula for Life, AD & D, ASI, CI'
        Prem = (.Cells(t, 2) * .Cells(t, 7)) / 1000
    Case 1103  'Formula for LTD'
        Prem = (.Cells(t, 2) * .Cells(t, 7)) / 100
    Case 1104  'Formula for STD'
        Prem = (.Cells(t, 2) * .Cells(t, 7))  / 10
    Case 2112  'General Formula'
        Prem = (.Cells(t, 2) * .Cells(t, 7)) 
End Select

.Cells(t, 9).Value = Prem
End With

Answer 2

使用application.screenupdating = false停止刷新屏幕。因此，在A）代码遇到application.screenupdating = true或所有代码完成后，用户将看不到发生了什么。这也应该加快代码时间。

Answer 3

如果有任何其他应用程序监视剪贴板，您的代码将失败。您无法复制，然后希望能够立即粘贴数据。一旦执行该副本，Windows就会通知其他应用程序更新，并且他们可以（并将）抓住剪贴板来获取数据。例如远程桌面，任何剪贴板监视器/扩展器，MS Office剪贴板，各种浏览器扩展，甚至谷歌地球。

至少，您需要在粘贴周围进行睡眠/重试循环。

如何使复制和粘贴循环更加流畅？ VBA EXCEL

3 个答案: