2

我搜索了整个网站，试图寻找一个宏（或函数），它将从相邻列中的给定列表创建独特的组合。

所以基本上，我有：

A  1  F1  R1  
B  2  F2  
C     F3  
D  
E

我正在尝试将所有信息列为（在同一个工作表和不同列中）：

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.

（能够切换列表在工作表上的打印位置的额外奖励）

4

3 回答 3

2

https://app.box.com/s/47b28f19d794b25511be上有一个工作簿，其中包含基于公式和基于 VBA 的方法。

于 2015-10-28T14:26:13.057 回答
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
于 2013-05-29T18:23:21.777 回答
0

试试这个 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
于 2015-04-28T23:48:53.020 回答