Excel VBA 宏生成可能组合的列表

Posted 2023-03-31

【中文标题】Excel VBA 宏生成可能组合的列表

【英文标题】：Excel VBA macro to generate a list of possible combinations

【发布时间】：2013-07-14 21:40:08

【问题描述】：

我正在尝试编写一个 excel 宏来生成可能组合的列表。

我在不同的列中有一系列固定的值

A、B、C、D - 每个都在自己的列中。

我有一个要替换为 A、B、C 或 D 的新值列表，并且想要生成所有组合。

新值列表，即 1、2、3、4

我总共会得到 16 种不同的组合

例如，

1BCD 2BCD 3BCD 4BCD A1CD A2CD A3CD

... ABC1 ABC2 ABC3 ABC4

我不确定这是否清楚，但我想通过遍历每一列来生成组合，以生成插入新值的可能组合。

【问题讨论】：

此处用于生成组合/排列的代码：groups.google.com/forum/#!msg/microsoft.public.excel.misc/…

【参考方案1】：

您可以使用以下内容交叉连接两个不同的范围。它将处理任何大小的范围并将交叉连接的组合写入您指定的目标工作表。

在下面的示例中，我定义了两个命名范围：newValues 和 fixedValues。这两个范围都在Sheet1。然后我遍历范围并将所有组合写入Sheet2。

Sub CrossJoinMyRanges()
    Dim ws As Worksheet
    Dim newValues As Range
    Dim cell As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set newValues = ws.Range("newValues")

    ' loop through the new values
    For Each cell In newValues
        Call ReplaceMe(cell.Value, ws)
    Next cell
End Sub

Sub ReplaceMe(replacement As String, ws As Worksheet)
    Dim fixedValues As Range
    Dim cell As Range

    Set fixedValues = ws.Range("fixedValues")

    ' outer loop through fixedValues
    For Each cell In fixedValues
        Call PrintReplacedValues(cell.Row, replacement)
    Next cell
End Sub

Sub PrintReplacedValues(rowNumber As Long, replacement As String)
    Dim wb As Workbook
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim fixedValues As Range
    Dim cell As Range
    Dim printMe As String
    Dim x As Long, y As Long

    Set wb = ThisWorkbook
    Set src = wb.Sheets("Sheet1")
    Set tgt = wb.Sheets("Sheet2")
    Set fixedValues = src.Range("fixedValues")
    y = 1
    x = tgt.Range("A" & tgt.Rows.Count).End(xlUp).Row + 1

    ' inner loop through fixed values
    For Each cell In fixedValues
        ' replace the fixed value with the replacement
        ' if the loops intersect
        If cell.Row = rowNumber Then
            printMe = replacement
        Else
        ' otherwise keep the fixed value
            printMe = cell
        End If
        ' write to the target sheet
        tgt.Cells(x, y).Value = printMe
        y = y + 1
    Next cell
End Sub

如果我的方法不是您所追求的，您也可以研究一些替代解决方案的类似问题：

Excel vba to create every possible combination of a Range

How can i obtain cartesian product like columns in excel?