Excel循環VBA增量行

Question

嗨我有一段代碼，我正在嘗試編寫一個循環，但我正在努力如何去做。

這部分代碼運行良好。但我實際上有4個單元格，即C26，C91，C156和C221。 （請參閱代碼中的容器1註釋）

我設法讓它循環，但是接下來我的引用（例如B33，C33，D33等）只是寫在頂端。無論如何寫一個循環，可以遞增所需的65行所有的後續代碼？

我真的很想學習如何正確執行此操作，而不是複製並粘貼4次並手動更新引用！

Private Sub RunStabSetup() 


' Confirmation of Entry to Form 

If MsgBox("Have you double checked your data is correct and ALL test points have been selected before entering on the spreadsheet?", vbYesNo) = vbNo Then Exit Sub 

Application.ScreenUpdating = False 

Application.Worksheets("Req Sheet").Range("C83") = " " 

If Container1CB.Value > "" Then 

'Container 1 

    Application.Worksheets("StabDataCapture").Range("C26") = Container1CB 

    '60° CheckBox logic statements 

    If W1T60.Value = True Then Application.Worksheets("StabDataCapture").Range("B33") = "1" 
    If W1T60.Value = False Then Application.Worksheets("StabDataCapture").Range("B33") = "" 

    If W2T60.Value = True Then Application.Worksheets("StabDataCapture").Range("C33") = "2" 
    If W2T60.Value = False Then Application.Worksheets("StabDataCapture").Range("C33") = "" 

    If W3T60.Value = True Then Application.Worksheets("StabDataCapture").Range("D33") = "3" 
    If W3T60.Value = False Then Application.Worksheets("StabDataCapture").Range("D33") = "" 

    If W4T60.Value = True Then Application.Worksheets("StabDataCapture").Range("E33") = "4" 
    If W4T60.Value = False Then Application.Worksheets("StabDataCapture").Range("E33") = "" 

    If W5T60.Value = True Then Application.Worksheets("StabDataCapture").Range("F33") = "5" 
    If W5T60.Value = False Then Application.Worksheets("StabDataCapture").Range("F33") = "" 

    If W6T60.Value = True Then Application.Worksheets("StabDataCapture").Range("G33") = "6" 
    If W6T60.Value = False Then Application.Worksheets("StabDataCapture").Range("G33") = "" 

    If W7T60.Value = True Then Application.Worksheets("StabDataCapture").Range("H33") = "7" 
    If W7T60.Value = False Then Application.Worksheets("StabDataCapture").Range("H33") = "" 

    If W8T60.Value = True Then Application.Worksheets("StabDataCapture").Range("I33") = "8" 
    If W8T60.Value = False Then Application.Worksheets("StabDataCapture").Range("I33") = "" 
End If 

End Sub 

感謝您幫助大家！

Answer 1

我想使它像：

i=2 
do while i<= maxColumn 
     If W1T60.Value = True Then Application.Worksheets("StabDataCapture").Cells(i,33).Value2 = i-1 
     If W1T60.Value = False Then Application.Worksheets("StabDataCapture").Cells(i,33).Value2 = "" 
loop 

從你的代碼，我看不出如何改變細胞（我，Ĵ）參數，所以我離開它不變，但類似的邏輯你可以修改它

Answer 2

有幾種不同的方法可以使用for循環和偏移功能來做到這一點。我可能會首先將您的範圍定義爲一系列範圍。 Dim rng(0 to 3) as Range然後定義每個4個細胞在C列

Set rng(0) = Range("C26") 
Set rng(1) = Range("C91") 
Set rng(2) = Range("C156") 
Set rng(3) = Range("C221") 

然後你可以附上你的「如果」語句for each循環。

Dim c As Variant 
For Each c In rng 
    if Container1CB.Value > "" Then 

     Sheets("StabDataCapture").c.Value = Container1CB 

     If W1T60.Value = True Then Sheets("StabDataCapture").c.Offset(7,-1).Value = "1" 
     If W1T60.Value = False Then sheets("StabDataCapture").c.Offset(7,-1).Value = "" 

     If W2T60.Value = True Then sheets("StabDataCapture").c.Offset(7,0).Value = "2" 
     If W2T60.Value = False Then sheets("StabDataCapture").c.Offset(7,0).Value = "" 

.... 

end if 

或者，你可以使用一個for循環像For i = 0 to 65*4 Step 65，你可以用Cells(i,3).Value

要設置你的「IF-THEN」語句的每個值取代之類的語句Range("C26")，最好的解決方法還是可能的陣列。 Dim WT(1 To 8) as Variant然後您可以設置數組的每個值等於W1T60，W2T60等的值。WT(1) = W1T60.Value。然後代碼可以更新爲：

Dim c As Variant 
Dim i as Integer 
For Each c In rng 
    if Container1CB.Value > "" Then 

     Sheets("StabDataCapture").c.Value = Container1CB 

     For i = 1 To 8 
      If WT(i) Then 
       Sheets("StabDataCapture").c.Offset(7, i - 2).Value = i 
      else 
       Sheets("StabDataCapture").c.Offset(7, i - 2).Value = "" 
      end if 
     next i 

    End If 
Next