[英]Excel VBA Copy and Paste Loop within Loop
我已經在VBA代碼上工作了一段時間了,由於我是一個完整的菜鳥,所以我覺得自己什么都沒得到。 我一直在研究大量內容,但似乎無法結合答案來幫助解決我的情況。
本質上,我想做的是從一個工作表中逐行獲取數據,並將其外推到另一個工作表。 我相信這會涉及循環,而我對VBA還是很陌生,我不知道該怎么做。
這是我嘗試的邏輯:對於工作表1的每一行,我想對工作表2執行3種不同的復制和粘貼活動,然后它將循環到sheet1的下一行並執行這3項活動,依此類推。 這將繼續向下,直到工作表1中的A列為空白。 Sheet1數據從A3開始,Sheets2粘貼區域從A2開始。
第一個活動是將單元格F3,D3,A3和H3(以此順序將F3復制為A2,D3為B2等)從工作表1復制到工作表2,再復制到A2,B2,C2等。目標函數可以不會被使用,因為我只需要值而無需其他格式,這是我遇到的許多問題之一。
下一個活動是將單元格F3,D3,A3和I3從工作表1復制到粘貼在先前復制下面的工作表2,然后粘貼-同樣,沒有格式只是值。 還要注意,其中一些可能為空(A列除外),但是我仍然需要至少包含A列數據的那一行-包括所有這些活動。
第三個活動是將工作表1的F3,D3和A3復制並粘貼一定的次數(參考K3的編號),並且每次復制和粘貼都將在下一個可用的空白單元格中。 因此,如果K3中的數字看起來像是在sheet2中創建了3行-由於activity1和2各自創建了自己的行,因此在sheet2上總共添加了5行。
在工作表1的第3行完成這三個活動之后,它將移至行4並執行前面的三個活動並粘貼到工作表2。 再一次,它將不粘貼任何格式,並粘貼在工作表2的下一個空白行中。同樣,一旦列A中的單元格為空白,此循環將停止。
下面是我不完整的代碼。 我什至不認為這會有所幫助,甚至最好不要看它。 因為我什至無法進行簡單的復制和粘貼,但是在循環中獨自循環,我才開始感到沮喪。 我什至還沒有開始我的第三項活動。 我非常感謝!
Sub copyTest3()
Dim proj As Range, release As Range, pm As Range, lead As Range, coord As Range
Dim leadCopy As Range, coordCopy As Range
Dim i As Range
Set proj = Range("A3", Range("A3").End(xlDown))
Set release = Range("D3", Range("D3").End(xlDown))
Set pm = Range("F3", Range("F3").End(xlDown))
Set lead = Range("H3", Range("H3").End(xlDown))
Set coord = Range("I3", Range("I3").End(xlDown))
Set leadCopy = Union(pm, release, proj, lead)
Set coordCopy = Union(pm, release, proj, coord)
For i = 1 To Range(ActiveSheet.Range("A3"), ActiveSheet.Range("A3").End(xlDown))
leadCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Sheet1").Activate
coordCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Next i
End Sub
我通常在Excel中的工作表之間復制數據的方法是創建源范圍和目標范圍對象,每個范圍僅引用一行。 當我想移至下一行時,我使用Offset
將范圍偏移返回到下一行。
由於范圍僅引用一行,因此您可以使用整數對它們進行索引以獲取該行中的單元格。 例如,如果cursor
指向第3行的A到D列, cursor(3)
將為您提供單元格C3。
Dim src_cursor As Range
Dim dest_cursor As Range
Set src_cursor = ActiveSheet.Range("A3:I3")
Set dest_cursor = Sheets("Sheet2").Range("A2:D2")
'' Loop until column A is empty in source data
Do Until IsEmpty(src_cursor(1))
dest_cursor(1) = src_cursor(6) '' copy F -> A
dest_cursor(2) = src_cursor(4) '' copy D -> B
'' and so on
'' move cursors to next row
Set src_cursor = src_cursor.Offset(1, 0)
Set dest_cursor = dest_cursor.Offset(1, 0)
Loop
同樣,這可能會有些偏離主題,但是最好使用Enum
命名列號,而不是像我在此處那樣對其進行硬編碼。
有許多方法可以做到這一點,有些方法比其他方法更有效。 我的解決方案可能不是最有效的,但是希望您可以輕松理解它,以便您學習。
很難理解您在活動三中要做什么,因此我無法為該步驟提供解決方案。 將我的代碼用作第三步的模板,如果遇到問題,請隨時發表評論。
注意,在此代碼中我沒有使用.Activate
, .Select
或.Copy
。 .Activate
和.Select
是巨大的效率殺手,它們使您的代碼更容易“破壞”,因此請盡可能避免使用它們。 .Copy
在使用值或公式時不是必需的,並且還會降低代碼速度。
未經測試
Sub testLoopPaste()
Dim i As Long
Dim ii As Long
Dim i3 as Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Sheet1")
Set sht2 = wb.Sheets("Sheet2")
'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
ii = 2
'This is the beginning of the loop
For i = 3 To LastRow
'First activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("H" & i).Value
ii = ii + 1
'Second activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("I" & i).Value
ii = ii + 1
'Third activity
For i3 = 1 To sht1.Range("K" & I)
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
ii = ii + 1
Next i3
Next i
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.