2

次の Excel と VBA の問題のように見えるものについて助けが必要です。

ここでの考え方は、各グループで可能なすべての組み合わせを (繰り返しなしで) 生成することです。

入力

COLUMN A | COLUMN B

A | 1

X | 1

D | 1

C | 2

E | 2

出力

COLUMN A | COLUMN B

A | X

A | D

X | D

X | A

D | A

D | X

C | E

E | C

私がなんとかしたこと....データが同じグループにある場合にのみ実行するにはどうすればよいですか。

Option Explicit

Sub Sample()

    Dim i As Long, j As Long
    Dim CountComb As Long, lastrow As Long

    Application.ScreenUpdating = False

    CountComb = 0: lastrow = 1

    For i = 1 To 10: For j = 1 To 10

        Range("G" & lastrow).Value = Range("A" & i).Value & "/" & _
                                     Range("B" & j).Value

        lastrow = lastrow + 1
        CountComb = CountComb + 1
    Next: Next

    Application.ScreenUpdating = True
End Sub
4

1 に答える 1

1

下記参照。Tools >> References に参照 Microsoft Scripting Runtime を追加する必要があることに注意してください。Range("A1:A5") を動的な名前付き範囲または静的範囲に変更すると、ルーチンが残りを処理します。G1 から始まる結果が表示されますが、これを変更したり、データ範囲からのオフセットとして動的にすることもできます。君による。

Option Explicit
Option Base 1

Dim Data As Dictionary

Sub GetCombinations()

    Dim dataObj As Variant
    Dim returnData As Variant
    Set Data = New Dictionary
    Dim i As Double

    dataObj = Range("A1:B5").Value2

    ' Group Data
    For i = 1 To UBound(dataObj) Step 1

        If (Data.Exists(dataObj(i, 2))) Then
            Data(dataObj(i, 2)) = Data(dataObj(i, 2)) & "|" & dataObj(i, 1)
        Else
            Data.Add dataObj(i, 2), dataObj(i, 1)
        End If

    Next i

    ' Extract combinations from groups
    returnData = CalculateCombinations().Keys()

    Range("G1").Resize(UBound(returnData) + 1, 1) = Application.WorksheetFunction.Transpose(returnData)

End Sub

Private Function CalculateCombinations() As Dictionary

    Dim i As Double, j As Double
    Dim datum As Variant, pieceInner As Variant, pieceOuter As Variant
    Dim Combo As New Dictionary
    Dim splitData() As String

    For Each datum In Data.Items

        splitData = Split(datum, "|")
        For Each pieceOuter In splitData
            For Each pieceInner In splitData

                If (pieceOuter <> pieceInner) Then

                    If (Not Combo.Exists(pieceOuter & "|" & pieceInner)) Then
                        Combo.Add pieceOuter & "|" & pieceInner, vbNullString
                    End If

                End If

            Next pieceInner
        Next pieceOuter

    Next datum

    Set CalculateCombinations = Combo

End Function
于 2012-11-21T13:41:02.863 に答える