在 Excel VBA 中创建组合
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16820113/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Create combinations in Excel VBA
提问by user2425910
I've scoured the entire website trying to look for a macro (or function) that will create unique combinations from a given list in adjacent columns.
我已经搜索了整个网站，试图寻找一个宏（或函数），该宏（或函数）将从相邻列中的给定列表中创建独特的组合。
So basically, I have:
所以基本上，我有：
A 1 F1 R1
B 2 F2
C F3
D
E
And I'm trying to list all the information as (in the same worksheet and in different columns):
我试图将所有信息列为（在同一工作表和不同列中）：
A 1 F1 R1
A 1 F2 R1
A 1 F3 R1
A 2 F1 R1
A 2 F2 R1
A 2 F3 R1
B 1 F1 R1
B 1 F2 R1
B 1 F3 R1
B 2 F1 R1
B 2 F2 R1
B 2 F3 R1
...etc.
(added bonus for being able to toggle where the list is printed on the sheet)
（能够切换列表在工作表上的打印位置的额外奖励）
回答by user2425910
The code to get all possible combinations as follows
获取所有可能组合的代码如下
Option Explicit
Sub Combinations()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim a As Range, b As Range, c As Range, d As Range
Dim x&, y&, z&, w&
For x = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
Set a = ws.Range("A" & x)
For y = 1 To ws.Range("B" & Rows.Count).End(xlUp).Row
Set b = ws.Range("B" & y)
For z = 1 To ws.Range("C" & Rows.Count).End(xlUp).Row
Set c = Range("C" & z)
For w = 1 To ws.Range("D" & Rows.Count).End(xlUp).Row
Set d = ws.Range("D" & w)
Debug.Print a & vbTab & b & vbTab & c & vbTab & d
Set d = Nothing
Next
Set c = Nothing
Next
Set b = Nothing
Next y
Set a = Nothing
Next x
End Sub
and the output
和输出
A 1 F1 R1
A 1 F2 R1
A 1 F3 R1
A 2 F1 R1
A 2 F2 R1
A 2 F3 R1
B 1 F1 R1
B 1 F2 R1
B 1 F3 R1
B 2 F1 R1
B 2 F2 R1
B 2 F3 R1
C 1 F1 R1
C 1 F2 R1
C 1 F3 R1
C 2 F1 R1
C 2 F2 R1
C 2 F3 R1
D 1 F1 R1
D 1 F2 R1
D 1 F3 R1
D 2 F1 R1
D 2 F2 R1
D 2 F3 R1
E 1 F1 R1
E 1 F2 R1
E 1 F3 R1
E 2 F1 R1
E 2 F2 R1
E 2 F3 R1
回答by shg
There's a workbook at https://app.box.com/s/47b28f19d794b25511bewith both formula- and VBA-based methods to do that.
https://app.box.com/s/47b28f19d794b25511be上有一本工作簿，其中包含基于公式和基于 VBA 的方法。
回答by shA.t
Try this VBA code:
试试这个 VBA 代码：
Type tArray
value As String
count As Long
End Type
Sub combineAll()
Dim sResult(10) As tArray, rRow(10) As Long, str() As String
Dim sRow As Long, sCol As Long
Dim i As Long, r As Long
Dim resRows As Long
sRow = 1: sCol = 1: r = 0
With ActiveSheet
Do
rRow(sCol) = 1
If (Trim(.Cells(sRow, sCol).value) = "") Then Exit Do
Do
If (Trim(.Cells(sRow, sCol).value) = "") Then Exit Do
sResult(sCol).value = sResult(sCol).value & Trim(.Cells(sRow, sCol).value) & ";"
sResult(sCol).count = sResult(sCol).count + 1
sRow = sRow + 1
Loop
sCol = sCol + 1
sRow = 1
Loop
Do
r = r + 1
For i = 1 To sCol - 1
str = Split(sResult(i).value, ";")
.Cells(r, sCol + i).value = str(rRow(i) - 1)
Next i
For i = sCol - 1 To 1 Step -1
If rRow(i) < sResult(i).count Then
rRow(i) = rRow(i) + 1
Exit For
Else
rRow(i) = 1
End If
Next i
If rRow(1) >= sResult(1).count Then Exit Do
Loop
End With
End Sub
