在Excel VBA中创build组合

我搜遍了整个网站，试图寻找一个macros（或函数），将创build相邻列中给定列表的唯一组合。

所以基本上，我有：

A 1 F1 R1 B 2 F2 C F3 DE 

我试图列出所有的信息（在同一个工作表和不同的列）：

 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. 

（可以切换列表打印在工作表上的附加奖励）

Answer 1

获取所有可能组合的代码如下

 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 

和输出

 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 

Answer 2

在https://app.box.com/s/47b28f19d794b25511be上有一个工作簿，使用基于公式和VBA的方法来做到这一点。

Answer 3

试试这个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