如何让我的复制和粘贴循环更顺利？ VBA EXCEL
我希望我的macros在一个单元格中select基于datediff值的特定数据select，然后将其复制并粘贴到另一个表单中。 它是这样做的，但它来回闪烁，出现一个闪闪发光的外表。 任何提示/想法如何解决它？
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 你可以像这样简化所有的代码块：
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
使用application.screenupdating = false可以停止刷新屏幕。 所以用户在A）代码遇到application.screenupdating = true或者所有的代码已经完成之后都不会看到发生了什么。 还应该加快编码时间。
如果有任何其他应用程序监视剪贴板，您的代码将失败。 你不能复制，然后期望立即能够粘贴数据。 只要您执行该复制，Windows就会通知其他应用程序更新，并且他们可以（也将）抓住剪贴板来抓取数据。 例如远程桌面，任何剪贴板监视器/扩展器，MS Office剪贴板，各种浏览器扩展，甚至谷歌地球。
至less，你需要一个睡眠/重试循环周围的粘贴。