Excel Loop 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

從您的代碼中，我看不到如何更改Cells（i， j ）參數，因此我將其保持不變，但是使用類似的邏輯，您可以對其進行修改

Answer 2

使用for循環和偏移功能，可以通過幾種不同的方法來實現。 我可能會通過首先將范圍定義為范圍數組來做到這一點。 Dim rng(0 to 3) as Range ，然后在C列中定義4個單元格中的每個單元格。

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

然后，您可以將“ if”語句括在每個循環中。

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替換Range("C26")類的語句。

要在“ IF-THEN”語句中設置每個值，最好的解決方法可能是數組。 Dim WT(1 To 8) as Variant ，然后將數組的每個值設置為等於W1T60，W2T60等的值。WT 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