可能的值组合

Question

我试图根据我的需要调整Sub + Function：

write all possible combinations

蒂姆·威廉姆斯解决方案。

它工作正常，因为所有列都至少有2个值。如果有一种解决方法可以使其工作，即使某些列中只有一个值，我也会这样做。

在Sub命令中我可以改为 col.Add Application.Transpose（sht.Range（Cells（3，c.Column），Cells（Rows.Count，c.Column）.End（xlUp））） 它很好。

但是功能在这一行崩溃了： ReDim pos（1到numIn） 就在处理只有一个值的列时。

事先提供任何帮助。

Answer 1

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

• 数据和写入单元格位于同一个活动表格
• 从您指定的单元格向下然后向右开始组合
• 只要同一行的单元格为空，就会向右停止
• 从您指定的单元格向下写入组合

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

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