Vba 可能的值组合

我正在尝试根据我的需要调整此线程的Sub+函数：

蒂姆·威廉姆斯解决方案

因为所有列都至少有2个值，所以它可以正常工作。我想知道是否有一种解决方法可以让它工作，即使某些列中只有一个值

在子命令中，我可以更改为 col.Add Application.Transpose（sht.Range（单元格（3，c.Column）、单元格（Rows.Count，c.Column）.End（xlUp）） 一切顺利

但函数在这一行崩溃了： 重拨位置（1到numIn） 就在处理只包含一个值的列时

---

请提前咨询Thaks以寻求帮助。

我有一个更优雅的解决方案，假设如下：

• 数据和写入单元格位于同一活动表上
• 从指定的单元格开始组合，然后向下再向右
• 当同一行的单元格为空时，停止向右移动
• 从指定的单元格向下写入组合

代码后的屏幕截图（错误仅在数据列的1行上修复）：

Private Const sSEP=“|””分隔符
子列表组合（）
变暗或变宽为范围，或变宽为范围
设置oRngWriteTo=范围（“E1”）
设置oRngTopLeft=范围（“A1”）
写入组合或写入，或写入左
将orngwrite设置为=无
Set oRngTopLeft=无
端接头
专用子写入组合（ByRef oRngWriteTo作为范围，ByRef oRngTop作为范围，可选的sPrefix作为字符串）
将iR变暗为“长”行偏移
Dim lLastRow作为同一列的最后一行
Dim sTmp作为字符串“临时字符串”
如果为空（oRngTop），则退出Sub“如果输入单元格为空，则退出”
lLastRow=单元格（Rows.Count，oRngTop.Column）.结束（xlUp）.行
“lLastRow=oRngTop.End（xlDown）.Row”添加一个
if-else
语句，检查numIn是
=1
还是
on error goto
并在其中处理ReDim
Private Const sSEP = "|" ' Separator Character

Sub ListCombinations()
    Dim oRngTopLeft As Range, oRngWriteTo As Range

    Set oRngWriteTo = Range("E1")
    Set oRngTopLeft = Range("A1")

    WriteCombinations oRngWriteTo, oRngTopLeft

    Set oRngWriteTo = Nothing
    Set oRngTopLeft = Nothing

End Sub

Private Sub WriteCombinations(ByRef oRngWriteTo As Range, ByRef oRngTop As Range, Optional sPrefix As String)
    Dim iR As Long ' Row Offset
    Dim lLastRow As Long ' Last Row of the same column
    Dim sTmp As String ' Temp string

    If IsEmpty(oRngTop) Then Exit Sub ' Quit if input cell is Empty
    lLastRow = Cells(Rows.Count, oRngTop.Column).End(xlUp).Row
    'lLastRow = oRngTop.End(xlDown).Row ' <- Bug when 1 row only
    For iR = 0 To lLastRow - 1
        sTmp = ""
        If sPrefix <> "" Then
            sTmp = sPrefix & sSEP & oRngTop.Offset(iR, 0).Value
        Else
            sTmp = oRngTop.Offset(iR, 0).Value
        End If
        ' No recurse if next column starts empty
        If IsEmpty(oRngTop.Offset(0, 1)) Then
            oRngWriteTo.Value = sTmp ' Write value
            Set oRngWriteTo = oRngWriteTo.Offset(1, 0) ' move to next writing cell
        Else
            WriteCombinations oRngWriteTo, oRngTop.Offset(0, 1), sTmp
        End If
    Next
End Sub