如何修改Excel全组合生成VBA代码使其自动忽略空白单元格

修改后的完整代码 #

Sub ListAllCombinations()
'Updateby Extendoffice
Dim xDRg1, xDRg2, xDRg3, xDRg4, xDRg5, xDRg6, xDRg7 As Range
Dim xRg  As Range
Dim xStr As String
Dim xFN1, xFN2, xFN3, xFN4, xFN5, xFN6, xFN7 As Integer
Dim xSV1, xSV2, xSV3, xSV4, xSV5, xSV6, xSV7 As String
' 范围已统一调整为对应列第2行到第52行，后续新增选项无需修改此处
Set xDRg1 = Range("A2:A52")  '第一列数据
Set xDRg2 = Range("B2:B52")  '第二列数据
Set xDRg3 = Range("C2:C52")  '第三列数据
Set xDRg4 = Range("D2:D52")  '第四列数据
Set xDRg5 = Range("E2:E52")  '第五列数据
Set xDRg6 = Range("F2:F52")  '第六列数据
Set xDRg7 = Range("G2:G52")  '第七列数据
xStr = "-"   '分隔符
Set xRg = Range("L2")  '输出起始单元格
For xFN1 = 1 To xDRg1.Count
    xSV1 = xDRg1.Item(xFN1).Text
    ' 单元格为空则跳过当前轮次
    If xSV1 = "" Then GoTo Next1
    For xFN2 = 1 To xDRg2.Count
        xSV2 = xDRg2.Item(xFN2).Text
        If xSV2 = "" Then GoTo Next2
      For xFN3 = 1 To xDRg3.Count
          xSV3 = xDRg3.Item(xFN3).Text
          If xSV3 = "" Then GoTo Next3
        For xFN4 = 1 To xDRg4.Count
            xSV4 = xDRg4.Item(xFN4).Text
            If xSV4 = "" Then GoTo Next4
          For xFN5 = 1 To xDRg5.Count
              xSV5 = xDRg5.Item(xFN5).Text
              If xSV5 = "" Then GoTo Next5
            For xFN6 = 1 To xDRg6.Count
                xSV6 = xDRg6.Item(xFN6).Text
                If xSV6 = "" Then GoTo Next6
              For xFN7 = 1 To xDRg7.Count
                  xSV7 = xDRg7.Item(xFN7).Text
                  If xSV7 = "" Then GoTo Next7
                  xRg.Value = xSV1 & xStr & xSV2 & xStr & xSV3 & xStr & xSV4 & xStr & xSV5 & xStr & xSV6 & xStr & xSV7
                  Set xRg = xRg.Offset(1, 0)
Next7:
                   Next
Next6:
                Next
Next5:
             Next
Next4:
          Next
Next3:
       Next
Next2:
    Next
Next1:
Next
End Sub

调整说明 #

• 7列的取值范围已全部修改为对应列第2行到第52行，后续在这个区间内新增选项时直接运行宏即可，不需要再修改代码里的范围定义
• 每层循环读取单元格值后新增了非空判断，只要当前单元格为空就直接跳过当前轮次，不会进入后续嵌套循环，彻底避免生成包含空白项的组合
• 额外优化了原代码生成的组合末尾多出来的分隔符问题，如果你需要保留末尾的-，可以把赋值语句末尾补回& xStr即可

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