excel - Excelシートのさまざまな列のデータのすべての可能な組み合わせを作成するマクロ？

Question

別の投稿で、ユーザーExcellllが前述の質問に対応するマクロアドレスを提供しました。

以下のようなデータを含むワークシートがあります。

A                      B           C
abc,def,ghi,jkl      1,2,3     a1,e3,h5,j8

次の解決策はそれをに変えます

abc  1  a1
abc  2  a1
abc  3  a1
abc  1  e3
abc  2  e3
abc  3  h5

ただし、データの列数が3列のデータから10列のデータに増加するときに、マクロをどのように変更できるかを知りたいと思いました。

表示されたコードのパターンに基づいてマクロを何度も変更しようとしましたが、エラーが発生し続けました。

score 0 · Accepted Answer

これは、再帰を使用して任意の数の列 (1 より大きい) を処理する一般化されたソリューションです。

Sub Combinations()
    Dim aSrc As Variant

    ' Get Data into an array
    '  This section is an example to get the source data into an array
    '  Replace this section if your data is sourced differently.
    '  The required format of aSrc is Array(1 To NumberOfColumnsOfData)
    '  where each element aSrc(n) is Array(1 To NumberOfRowsInColumnN, 1 To 1) of Variant
    Dim rSrc As Range, colR As Range
    Dim sh As Worksheet
    Dim a As Variant
    Dim i As Long
    Set sh = ActiveSheet ' <-- Adjust to suit
    Set rSrc = sh.[A:D]  ' <-- Adjust to suit
    ReDim aSrc(1 To rSrc.Columns.Count)
    With sh
        For i = 1 To rSrc.Columns.Count
            Set colR = rSrc.Columns(i)
            aSrc(i) = .Range(colR.Cells(1, 1), colR.Cells(.Rows.Count, 1).End(xlUp))
        Next
    End With

    ' Generate output
    '  This populates aDst(1 To lSize, 1 To NumberOfSourceColumns)
    '  where lSize is total number of combinations
    Dim aDst As Variant
    Dim lSize As Long
    Dim n As Long
    Dim aBase() As String
    lSize = 1
    For i = 1 To UBound(aSrc)
        lSize = lSize * UBound(aSrc(i), 1)
    Next
    ReDim aDst(1 To lSize, 1 To UBound(aSrc))
    ReDim aBase(0 To UBound(aSrc) - 1)
    n = 1
    aBase = Split(String(UBound(aSrc) - 1, ","), ",")
    aBase(0) = aSrc(1)(1, 1)
    Generate aSrc, aDst, aBase, 1, n

    ' Place output into sheet
    '   Starting at cell rDst
    Dim rDst As Range
    Set rDst = [E1]  ' <-- Adjust to suit
    Set rDst = rDst.Resize(UBound(aDst, 1), UBound(aDst, 2))
    rDst = aDst

End Sub

Private Sub Generate(ByRef aSrc As Variant, ByRef aDst As Variant, ByRef aBase As Variant, ByVal pCol As Long, ByRef pDst As Long)
    Dim i As Long, j As Long
    If pCol = UBound(aSrc) Then
        ' If iterating the last source column, output to aDst
        For i = 1 To UBound(aSrc(pCol), 1)
            For j = 1 To UBound(aBase)
                aDst(pDst, j) = aBase(j - 1)
            Next
            aDst(pDst, j) = aSrc(pCol)(i, 1)
            pDst = pDst + 1
        Next
    Else
        ' If NOT iterating the last source column, aBase and call Generate again
        For i = 1 To UBound(aSrc(pCol), 1)
            aBase(pCol - 1) = aSrc(pCol)(i, 1)
            Generate aSrc, aDst, aBase, pCol + 1, pDst
        Next
    End If
End Sub

score 0 · Accepted Answer

私は再帰のファンですが、それが最も簡単な解決策を提供すると信じている場合に限ります。この問題には適していないと思います。

元の質問では、UJ9 には次のものがありました。

Column    A                B         C
Row 1     abc,def,ghi,jkl  1,2,3     a1,e3,h5,j8

そして欲しかった：

Column    A    B   C
Row  1    abc  1   a1
Row  2    abc  2   a1
Row  3    abc  3   a1
Row  4    abc  1   e3
Row  5    abc  2   e3
Row  6    abc  3   h5
 :
Row 48    jkl  3   j8

user1657410 は同じものを望んでいますが、10 列あります。

元の問題の解決策では、ネストされた for ループを 3 つ (列ごとに 1 つ) 使用します。これらのソリューションを 10 個のネストされた for ループに適応させることは可能ですが、簡単に実装することはできません。これらのソリューションの背後にある原則を検討してから、別の実装戦略を探してみましょう。

各列の値にインデックスを付けると、次のようになります。

Column    A                B         C
Row 1     abc,def,ghi,jkl  1,2,3     a1,e3,h5,j8
Index     0   1   2   3    0 1 2     0  1  2  3

ソリューションが行うことは、インデックスのすべての組み合わせを生成することです: 000 001 002 003 010 011 012 013 020 021 021 023 100 ... 323 および数字を使用して、適切な文字列から適切な部分文字列を選択します。

このアプローチを多数の列に適応させるには、ネストされた for ループから、列ごとに 1 つのエントリを持つ配列に切り替える必要があります。1 つの配列は列のインデックスの最大値を保持し、もう 1 つの配列は現在選択されているインデックスを保持します。初期状態は次のようになります。

Column               A    B    C    D    E    F    G    H    I    J
Maximum index array  4    3    4    4    3    2    6    3    4    2
Current index array  0    0    0    0    0    0    0    0    0    0

ここで、各列に独自の最大値があることを除いて、速度計のように現在のインデックス配列をインクリメントするループが必要です。つまり、Current インデックス配列の右端の要素が既に最大値に達していない限り、1 を追加します。最大値の場合はゼロにリセットされ、最大値でない限り左隣の列がインクリメントされます。これは、ループが最大値を超えて左端のインデックスをインクリメントするまで続きます。つまり、現在のインデックス配列を次の値に設定するループが必要です。

Column               A    B    C    D    E    F    G    H    I    J
Maximum index array  4    3    4    4    3    2    6    3    4    2
Current index array  0    0    0    0    0    0    0    0    0    0
                     0    0    0    0    0    0    0    0    0    1
                     0    0    0    0    0    0    0    0    0    2
                     0    0    0    0    0    0    0    0    1    0
                     0    0    0    0    0    0    0    0    1    1
                     0    0    0    0    0    0    0    0    1    2
                     0    0    0    0    0    0    0    0    2    0
                     0    0    0    0    0    0    0    0    2    1
                     0    0    0    0    0    0    0    0    2    2
                     0    0    0    0    0    0    0    0    3    0
                     0    0    0    0    0    0    0    0    3    1
                     0    0    0    0    0    0    0    0    3    2
                     0    0    0    0    0    0    0    1    0    0
       :      :
                     4    3    4    4    3    2    6    3    4    2

Current インデックス配列の異なる値ごとに、各列から適切な部分文字列を選択し、部分文字列を含む行を生成します。

先に進む前に、部分文字列の組み合わせごとに行を生成しますか? この例で選択した最大インデックス値では、2,520,000 行が得られます。

以下のコードは、ソース行が行 1 であると想定しています。生成された行を行 3 から出力します。このコードは、上記のようなテーブルを生成するため、コードの動作を正しく理解できます。このコードの下には、部分文字列を出力するように修正するための指示があります。ソース行の列数に合わせてコードが調整されます。コードは、Excel のバージョンが生成された行数をサポートできるかどうかをチェックしません。

Sub Combinations()

  Dim ColCrnt As Long
  Dim ColMax As Long
  Dim IndexCrnt() As Long
  Dim IndexMax() As Long
  Dim RowCrnt As Long
  Dim SubStrings() As String
  Dim TimeStart As Single

  TimeStart = Timer

  With Worksheets("Combinations")

    ' Use row 1 as the source row.  Find last used column.
    ColMax = .Cells(1, Columns.Count).End(xlToLeft).Column

    ' Size Index arrays according to number of columns
    ' Use one based arrays so entry number matches column number
    ReDim IndexCrnt(1 To ColMax)
    ReDim IndexMax(1 To ColMax)

    ' Initialise arrays
    For ColCrnt = 1 To ColMax
      SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
      ' SubStrings is a zero-based array with one entry
      ' per comma separated value.
      IndexMax(ColCrnt) = UBound(SubStrings)
      IndexCrnt(ColCrnt) = 0
    Next

    RowCrnt = 3     ' Output generated values starting at row 3

    Do While True

      ' Use IndexCrnt() here.
      ' For this version I output the index values
      For ColCrnt = 1 To ColMax
        ' This will generate an error if RowCrnt exceeds the maximum number
        ' of columns for your version of Excel.  
        .Cells(RowCrnt, ColCrnt).Value = IndexCrnt(ColCrnt)
      Next
      RowCrnt = RowCrnt + 1

      ' Increment values in IndexCrnt() from right to left
      For ColCrnt = ColMax To 1 Step -1
        If IndexCrnt(ColCrnt) < IndexMax(ColCrnt) Then
          ' This column's current index can be incremented
          IndexCrnt(ColCrnt) = IndexCrnt(ColCrnt) + 1
          Exit For
        End If
        If ColCrnt = 1 Then
          ' Leftmost column has overflowed.
          ' All combinations of index value have been generated.
          Exit Do
        End If
        IndexCrnt(ColCrnt) = 0
        ' Loop to increment next column
      Next

    Loop

  End With

  Debug.Print Format(Timer - TimeStart, "#,###.##")

End Sub

上記のコードを理解して満足している場合は、次のように置き換えてください。

      ' For this version I output the index values
      For ColCrnt = 1 To ColMax
        .Cells(RowCrnt, ColCrnt).Value = IndexCrnt(ColCrnt)
      Next

に：

      For ColCrnt = 1 To ColMax
        SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
        .Cells(RowCrnt, ColCrnt).Value = SubStrings(IndexCrnt(ColCrnt))
      Next

この修正されたコードは、組み合わせごとに適切な部分文字列を出力しますが、生成された行ごとにソースセルから必要な部分文字列を抽出するため、組み合わせが多数ある場合は遅くなります。たとえば、12.66 秒で 27,648 行が生成されます。以下のコードは 9.15 秒かかりますが、より高度な手法を使用しています。

ステップ 1、以下を置き換えます。

  Dim SubStrings() As String

に：

  Dim SubStrings() As Variant

ではDim SubStrings() As String、SubString(N) には文字列のみを含めることができます。ではDim SubStrings() As Variant、SubString(N) に文字列、整数、または浮動小数点値を含めることができます。バリアントは文字列や long よりも処理が遅く、コードに間違った種類の値を設定しても警告が表示されないため、ほとんどの状況ではこれは適切ではありません。ただし、配列を SubString(N) に格納します。各行の列数が異なるため、不規則配列と呼ばれるものを使用します。

ステップ 2、以下を置き換えます。

    ReDim IndexCrnt(1 To ColMax)
    ReDim IndexMax(1 To ColMax)

に：

    ReDim IndexCrnt(1 To ColMax)
    ReDim IndexMax(1 To ColMax)
    ReDim SubStrings(1 To ColMax)

ステップ 3、以下を置き換えます。

    ' Initialise arrays
    For ColCrnt = 1 To ColMax
      SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
      ' SubStrings is a zero-based array with one entry
      ' per comma separated value.
      IndexMax(ColCrnt) = UBound(SubStrings)
      IndexCrnt(ColCrnt) = 0
    Next

に：

    ' Initialise arrays
    For ColCrnt = 1 To ColMax
      SubStrings(ColCrnt) = Split(.Cells(1, ColCrnt).Value, ",")
      IndexMax(ColCrnt) = UBound(SubStrings(ColCrnt))
      IndexCrnt(ColCrnt) = 0
    Next

最初のバージョンでは、セルを分割するたびに配列 SubStrings を上書きします。2 番目のバージョンでは、各列の部分文字列を保存します。元の質問で UJ9 が使用した値を使用すると、新しい SubString は次のようになります。

        ---- Columns -----
Row     0    1    2    3  
  1     abc  def  ghi  jkl
  2     1    2    3
  3     a1   e3   h5   j8

ステップ 4: 交換:

      For ColCrnt = 1 To ColMax
        SubStrings = Split(.Cells(1, ColCrnt).Value, ",")
        .Cells(RowCrnt, ColCrnt).Value = SubStrings(IndexCrnt(ColCrnt))
      Next

に：

      For ColCrnt = 1 To ColMax
        .Cells(RowCrnt, ColCrnt).Value = SubStrings(ColCrnt)(IndexCrnt(ColCrnt))
      Next

改訂されたコードでは、生成された値ごとにソースセルを分割しません。配列から必要な部分文字列を抽出します。

注: 2 次元配列を使用したことがある場合は、次のように記述しますMyArray(Row,Column)。不規則な配列は異なります。あなたが書くMyArray(Row)(Column)。

excel - Excelシートのさまざまな列のデータのすべての可能な組み合わせを作成するマクロ？

2 に答える 2

Related

Reference