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