VBA通​​過IF聲明循環

Question

VBA編程新手，但需要它來完成項目。

我基本上試圖複製和粘貼基於IF聲明的單元格，並希望在逐個單元格的基礎上做到這一點，所以我併入了一個循環。代碼如下所示。結果發生的是第一行復制/粘貼很好，但循環不會繼續。當我使用debug.print i時，唯一填充的數字是6。我也嘗試了For聲明，但最終表現方式相同。有任何想法嗎？

Private sub Copy_Dates() 
Dim i as Integer 
i =6 

Do 
    If Cells(i,79)= 1 then 
     Sheets("Tracking").Select 
     Range(Cells(i,106),Cells(i,108)).Copy 

     Sheets("Tr_Tracking").Select 
     Range(Cells(i_25003,2),cells(i+25003,4)).PasteSpecial Paste:=xlPasteValues 
    End if 
i= i+1 
Loop while i < 10 

End sub 

編輯： 所以我已經意識到我想要的代碼不會是我的項目非常有幫助了。我真正需要的是一種根據條件選擇非連續單元格的方法，然後將這些單元格作爲單個塊複製到另一個工作表中。

所以，從上面的代碼同時，我需要確保選擇

.range(.cells(i,106,.cells(i,108)) 

只有在滿足以下條件：

if .cells(i,79)=1 

然後想象我將有一些陣基於這個條件選擇的單元格，然後我將能夠將其粘貼到上面定義的第二張紙上wsO=thisworkbook.sheets("TR_Tracking")。

我希望這是有道理的，希望不要太複雜的邏輯。

編輯：編輯： 我能弄明白這一個。我使用下面的代碼來完成上面的編輯部分。

Private Sub SelectArray_andCopy() 
Dim FinalSelection as Range 
Sheets("Tracking").Select 
Cells(2,79).Select 
For each c in intersect(activesheet.usedrange,range("CA6:CA500")) 
    if c.value=1 then 
     if finalselection is nothing then 
      set finalselection=range(cells(c.row,106),cells(c.row,108)) 
     else 
      set finalselection = union(finalselection, range(cells(c.row,106,cells(c.row,108))) 
     end if 
    end if 
next c 
if not finalselection is nothing then finalselection.select 

Selection.copy 
Sheets("TR_Tracking").Select 
Range("b250009,d26000").PasteSpecial Paste:=xlPasteValues 

Answer 1

問題是您正在使用.Select，因此焦點在變化。您的單元格對象也不完全合格。

INTERESTING READ

而且i_25003不正確。我猜你的意思i + 25003

試試這個（UNTESTED）

Private Sub Copy_Dates() 
    Dim wsI As Worksheet, wsO As Worksheet 
    Dim i As Long 

    Set wsI = ThisWorkbook.Sheets("Tracking") 
    Set wsO = ThisWorkbook.Sheets("Tr_Tracking") 

    For i = 6 To 9 
     With wsI 
      If .Cells(i, 79) = 1 Then 
       wsO.Range(wsO.Cells(i + 25003, 2), wsO.Cells(i + 25003, 4)).Value = _ 
       .Range(.Cells(i, 106), .Cells(i, 108)).Value 
      End If 
     End With 
    Next i 
End Sub