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 回答