VBA错误‘For control variable already in use’排查及组合生成代码修正求助

感谢@chris neilsen、Siddharth Rout、FunThomas、user10186832帮忙理清提问思路。作为Excel VBA新手，为之前的失误致歉。

需求说明 #

• B2:B13为点数，C2:C13为重复次数，需生成如F、J、N列所示的组合模式
• 生成多列组合后，删除包含空白单元格的行

遇到的问题 #

自行编写的代码运行时弹出错误提示For control variable already in use，错误触发时VBA编辑器中第二个Sub combinations()被高亮，请求帮忙修正代码。

原代码 #

Sub combinations()
i = 1
For Each cella In Sheet3.Range("A:A").SpecialCells(xlCellTypeConstants)
    For Each cellb In Sheet3.Range("B:B").SpecialCells(xlCellTypeConstants)
        For Each cellc In Sheet3.Range("C:C").SpecialCells(xlCellTypeConstants)
            For Each cellc In Sheet3.Range("D:D").SpecialCells(xlCellTypeConstants)
                For Each cellc In Sheet3.Range("E:E").SpecialCells(xlCellTypeConstants)
                    For Each cellc In Sheet3.Range("F:F").SpecialCells(xlCellTypeConstants)
                        For Each cellc In Sheet3.Range("G:G").SpecialCells(xlCellTypeConstants)
                            For Each cellc In Sheet3.Range("H:H").SpecialCells(xlCellTypeConstants)
                                For Each cellc In Sheet3.Range("I:I").SpecialCells(xlCellTypeConstants)
                                    For Each cellc In Sheet3.Range("J:J").SpecialCells(xlCellTypeConstants)
                                        For Each cellc In Sheet3.Range("K:K").SpecialCells(xlCellTypeConstants)
                                            For Each cellc In Sheet3.Range("L:L").SpecialCells(xlCellTypeConstants)
                                                For Each cellc In Sheet3.Range("M:M").SpecialCells(xlCellTypeConstants)
                                                    Sheet9.Range("A" & i).Value = cella.Value
                                                    Sheet9.Range("B" & i).Value = cellb.Value
                                                    Sheet9.Range("C" & i).Value = cellc.Value
                                                    Sheet9.Range("D" & i).Value = cellc.Value
                                                    Sheet9.Range("E" & i).Value = cellc.Value
                                                    Sheet9.Range("F" & i).Value = cellc.Value
                                                    Sheet9.Range("G" & i).Value = cellc.Value
                                                    Sheet9.Range("H" & i).Value = cellc.Value
                                                    Sheet9.Range("I" & i).Value = cellc.Value
                                                    Sheet9.Range("J" & i).Value = cellc.Value
                                                    Sheet9.Range("K" & i).Value = cellc.Value
                                                    Sheet9.Range("L" & i).Value = cellc.Value
                                                    Sheet9.Range("M" & i).Value = cellc.Value
                                                    i = i + 1
                                                Next
                                            Next
                                        Next
                                    Next
                                Next
                            Next
                        Next
                    Next
                Next
            Next
        Next
    Next
Next

Set mysheet1 = Sheet9
    row1 = mysheet1.UsedRange.Rows.Count
    For i = row1 To 1 Step -1
    If Len(mysheet1.Cells(i, 1).Value) = 0 Then
      mysheet1.Cells(i, 1).EntireRow.Delete
    End If
Next
' 原代码缺少End Sub
End Sub

错误原因及修正方案 #

1. 重复使用循环控制变量：原代码中多次用cellc作为嵌套循环的控制变量，VBA不允许同一作用域内重复使用循环变量，需为每个循环定义唯一变量（如celld、celle...cellm）。
2. 赋值错误：原代码中C到M列都赋值为cellc.Value，实际应对应各自循环的变量值。
3. 删除空白行逻辑不完善：原代码只检查第一列是否为空，需改为检查整行是否存在空白单元格。
4. 范围优化：避免使用整列Range("A:A")，改用实际数据范围提升效率。

修正后的代码 #

Sub GenerateCombinations()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim rngA As Range, rngB As Range, rngC As Range, rngD As Range
    Dim rngE As Range, rngF As Range, rngG As Range, rngH As Range
    Dim rngI As Range, rngJ As Range, rngK As Range, rngL As Range, rngM As Range
    Dim cella As Range, cellb As Range, cellc As Range, celld As Range
    Dim celle As Range, cellf As Range, cellg As Range, cellh As Range
    Dim celli As Range, cellj As Range, cellk As Range, celll As Range, cellm As Range
    Dim currentRow As Long
    
    ' 设置工作表对象
    Set wsSource = Sheet3
    Set wsTarget = Sheet9
    currentRow = 1
    
    ' 获取各列实际数据范围（避免整列遍历）
    Set rngA = wsSource.Range("A2:A" & wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row)
    Set rngB = wsSource.Range("B2:B" & wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row)
    Set rngC = wsSource.Range("C2:C" & wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row)
    Set rngD = wsSource.Range("D2:D" & wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row)
    Set rngE = wsSource.Range("E2:E" & wsSource.Cells(wsSource.Rows.Count, "E").End(xlUp).Row)
    Set rngF = wsSource.Range("F2:F" & wsSource.Cells(wsSource.Rows.Count, "F").End(xlUp).Row)
    Set rngG = wsSource.Range("G2:G" & wsSource.Cells(wsSource.Rows.Count, "G").End(xlUp).Row)
    Set rngH = wsSource.Range("H2:H" & wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp).Row)
    Set rngI = wsSource.Range("I2:I" & wsSource.Cells(wsSource.Rows.Count, "I").End(xlUp).Row)
    Set rngJ = wsSource.Range("J2:J" & wsSource.Cells(wsSource.Rows.Count, "J").End(xlUp).Row)
    Set rngK = wsSource.Range("K2:K" & wsSource.Cells(wsSource.Rows.Count, "K").End(xlUp).Row)
    Set rngL = wsSource.Range("L2:L" & wsSource.Cells(wsSource.Rows.Count, "L").End(xlUp).Row)
    Set rngM = wsSource.Range("M2:M" & wsSource.Cells(wsSource.Rows.Count, "M").End(xlUp).Row)
    
    ' 生成所有组合
    For Each cella In rngA
        For Each cellb In rngB
            For Each cellc In rngC
                For Each celld In rngD
                    For Each celle In rngE
                        For Each cellf In rngF
                            For Each cellg In rngG
                                For Each cellh In rngH
                                    For Each celli In rngI
                                        For Each cellj In rngJ
                                            For Each cellk In rngK
                                                For Each celll In rngL
                                                    For Each cellm In rngM
                                                        ' 赋值到目标工作表
                                                        wsTarget.Cells(currentRow, "A").Value = cella.Value
                                                        wsTarget.Cells(currentRow, "B").Value = cellb.Value
                                                        wsTarget.Cells(currentRow, "C").Value = cellc.Value
                                                        wsTarget.Cells(currentRow, "D").Value = celld.Value
                                                        wsTarget.Cells(currentRow, "E").Value = celle.Value
                                                        wsTarget.Cells(currentRow, "F").Value = cellf.Value
                                                        wsTarget.Cells(currentRow, "G").Value = cellg.Value
                                                        wsTarget.Cells(currentRow, "H").Value = cellh.Value
                                                        wsTarget.Cells(currentRow, "I").Value = celli.Value
                                                        wsTarget.Cells(currentRow, "J").Value = cellj.Value
                                                        wsTarget.Cells(currentRow, "K").Value = cellk.Value
                                                        wsTarget.Cells(currentRow, "L").Value = celll.Value
                                                        wsTarget.Cells(currentRow, "M").Value = cellm.Value
                                                        currentRow = currentRow + 1
                                                    Next cellm
                                                Next celll
                                            Next cellk
                                        Next cellj
                                    Next celli
                                Next cellh
                            Next cellg
                        Next cellf
                    Next celle
                Next celld
            Next cellc
        Next cellb
    Next cella
    
    ' 删除包含空白单元格的行
    Dim lastRow As Long, i As Long
    lastRow = wsTarget.UsedRange.Rows.Count
    For i = lastRow To 1 Step -1
        If WorksheetFunction.CountBlank(wsTarget.Rows(i)) > 0 Then
            wsTarget.Rows(i).Delete
        End If
    Next i
End Sub

内容的提问来源于stack exchange，提问作者SP160477