如何讓我的複製和粘貼循環更加流暢？ VBA EXCEL

我希望我的宏根據一個單元格中的datediff值選擇特定的數據選擇，然後複製並粘貼到另一個表單中。它是這樣做的，但是它來回閃爍，出現一個閃爍不定的外觀。任何提示/想法如何解決它？如何讓我的複製和粘貼循環更加流暢？ VBA EXCEL

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

來源

2014-03-07 s.patter

[This]（http://msdn.microsoft.com/zh-cn/library/office/ff193498（v = office.15）.aspx）可能對您有所幫助...此外，[請參閱此處] （http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select/10718179#10718179）提示如何使您的代碼更健壯。 – ARich

你可以簡化所有的代碼塊這樣的：

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

來源

2014-03-07 15:05:44

非常感謝！那正是我需要的！ –

不客氣！我做了修訂，並簡化了代碼的另一大塊。乾杯。 OMG！ –

謝謝！它快得多，只需一個動作！你真了不起！：'） –

使用application.screenupdating = false從被刷新停止屏幕。所以用戶在A）代碼遇到application.screenupdating = true或所有代碼已經完成之後將不會看到發生了什麼。這也應該加快編碼時間。

來源

2014-03-07 15:07:17 user1759942

如果有其他應用程序監視剪貼板，您的代碼將失敗。您無法複製，然後期望立即能夠粘貼數據。只要您執行該複製，Windows就會通知其他應用程序更新，並且他們可以（並將）抓住剪貼板來抓取數據。例如遠程桌面，任何剪貼板監視器/擴展器，MS Office剪貼板，各種瀏覽器擴展，甚至谷歌地球。

至少，您需要一個圍繞粘貼的睡眠/重試循環。

來源

2014-03-07 15:08:13

如何讓我的複製和粘貼循環更加流暢？ VBA EXCEL

回答

相關問題