只貼最後一段代碼

我對這個軟件比較新，可以真的用一隻手。我正在使用Ditta將多個項目存儲在剪貼板上，並給他們一個快捷方式。有了這個腳本，我試圖用快捷鍵一次性粘貼所有複製的項目。我已經單獨測試了每個代碼塊，它的工作原理。但是當我嘗試一起運行它時，它只運行最後的塊。有誰知道爲什麼會發生這種情況？只貼最後一段代碼

Sub Data() 
    ActiveCell.Select 
    SendKeys "^4", True 
    Application.Wait (2000) 

    ActiveCell.Offset(0, 1).Range("A1").Select 
    SendKeys "^3", True 
    Application.Wait (1000) 

    ActiveCell.Offset(0, 1).Range("A1").Select 
    SendKeys "^2", True 
    Application.Wait (1000) 

    ActiveCell.Offset(0, 1).Range("A1").Select 
    SendKeys "^1", True 
    Application.Wait (1000) 
End Sub

來源

2017-08-31 Joe Davison

你真的想連續3次選擇完全相同的內容嗎？ – Stewbob

不，理想情況下，我希望它在一列中發佈每個單獨的數據。 –

例如Name = A1，Email = B1 ect –

我不知道確切的問題在哪裏，但似乎是等待Ditto插入值。你的代碼只是等待粘貼完成。

我寫了一個解決辦法：

我們有一個循環，現在運行4至1倒計數（這是送的4個按鍵這比4倍相同的代碼更容易。
主要想法是在粘貼之前清除單元格，粘貼之後等待單元格不再爲空，這意味着粘貼是成功的，注意這只是一個解決方法，直到粘貼完成爲止的時間

Option Explicit 

Public Sub InsertData() 
    Dim i As Long 
    For i = 4 To 1 Step -1     'loop from 4 to 1 backwards 
     ActiveCell.Clear     'clear active cell (so we know it is empty for sure) 
     SendKeys "^" & CStr(i), True  'send keys for paste 

     'wait until active cell isn't empty anymore. 
     'this means wait until paste is done 
     Do While IsEmpty(ActiveCell) 
      DoEvents 'give Excel some time to handle other events 
     Loop 

     'move over to the next cell 
     ActiveCell.Offset(0, 1).Select 
    Next i 
End Sub

只是說明你原來的代碼

你的等待是錯誤反正Application.Wait(2000)沒有你希望它做什麼。正確的方法是：

Application.Wait(Now + TimeValue("0:00:02"))

讓它等待2秒鐘。給定的時間不是的數量的等待時間，而是的絕對時間，直到宏等待。欲瞭解更多信息，請參閱Application.Wait Method。

來源

2017-08-31 14:10:25

這是偉大的，我已經清楚地看到它的工作幾次，它ocasionaly只貼第一個或兩個。爲什麼這是 –

@JoeDavison這可能是當Ditto中的4個粘貼槽之一爲空時。然後，此解決方法將無法工作。它是否總是與相同的數據發生？在Ditto中是否有4個粘貼槽填充了數據（不是空的）？同時確保代碼在運行時不要點擊任何地方。您能否告訴我們它是否可以在同上的4個插槽中的任何一組數據上重現，還是偶爾會發生** **相同的** 4數據？ –

我從網上覆制了多個數據點，理想地希望我能夠更快地將它移動到excel中。爲了回答你的問題，是的，所有的插槽都被填滿，它們都包含不同的數據你能想到更快更高效的方法嗎？ –

只貼最後一段代碼

回答

相關問題