web-dev-qa-db-ja.com

範囲の可能なすべての組み合わせを作成するExcel vba

私はWeb上のどこにも見つけることができなかったという問題があります(あるかもしれませんが、それを見つけることができません)。

13列のデータを含むスプレッドシートがあります。各列には、全体的なテストケースに入る必要があるパラメーターのバリエーションが含まれています。

それらのすべてが異なります

E:
101%
105%
110%
120%

J:
アッパーS
アップサイドL
ダウンサイドB
プレミアムV

ネストされたループを使用する組み合わせの問題に対するいくつかの解決策を見てきました。 13のネストされたループを回避したいのですが(現時点ではこれが最善の策です)。各列ですべての一意の組み合わせを生成する方法に少し困っています。

それが皆さんにとって十分な意味があるかどうかはわかりません。誰かが再帰的アルゴリズムで少なくとも私を正しい方向に向けることができることを望んでいました。さまざまな数の列と行を取得するのに十分なほど動的にする必要があります。

皆さんが私に与えることができる助けをありがとう。

11
Kelvin

ODBCアプローチを提供したので、これを行う方法がすぐに明確ではないため、詳しく説明する必要があると思いました。そして、正直なところ、プロセスを再学習して自分で文書化する必要がありました。 。

これは、ExcelとMicrosoft Queryを使用して、2つ以上の1次元データ配列の デカルト積 を生成する方法です。

これらの手順はXL2007で書かれていますが、どのバージョンでもマイナーな変更(ある場合)で機能するはずです。

ステップ1

列に配列を整理します。

重要:以下の太字で示すように、各列には2つの「ヘッダー」名が必要です。最上位の名前は後で「テーブル名」として解釈されます。 2番目の名前は「列名」として解釈されます。これは数ステップ後に明らかになります。

両方の「ヘッダー」を含む各データ範囲を順番に選択し、Ctrl+Shift+F3を押します。 [名前の作成]ダイアログでTop rowのみにチェックマークを付け、OKをクリックします。

名前付き範囲がすべて確立されたら、ファイルを保存します。

enter image description here

ステップ2

データ|外部データを取得する|他のソースから| Microsoft Queryから

<New Data Source>を選択します。 Choose New Data Sourceダイアログで:

  1. 接続のわかりやすい名前

  2. 適切なMicrosoft Excelドライバーを選択する

...次にConnect

enter image description here

ステップ3

Select Workbook...次に、ファイルを参照します。

enter image description here

ステップ4

「テーブル」から「列」を追加します。ステップ1の「2ヘッダー」レイアウトが重要である理由がわかります。ドライバーをだましてデータを正しく理解させます。

次にCancelをクリックします(本当に!)。この時点で、「Microsoft Queryで編集を続行しますか?」というプロンプトが表示される場合があります。 (回答Yes)、または結合の不満はグラフィカルエディタでは表現できません。これを無視して偽造...

enter image description here

手順5

Microsoft Queryが開き、デフォルトでは、追加したテーブルが相互結合されます。これにより、デカルト積が生成されます。

次に、MSQueryを完全に閉じます。

enter image description here

手順6

ワークシートに戻ります。ほぼ完了です。 New worksheetおよびOKにチェックマークを付けます。

enter image description here

手順7

相互結合された結果が返されます。

enter image description here

22
andy holaday

ループを嫌う理由がわかりません。この例を参照してください。 1秒もかかりませんでした。

Option Explicit

Sub Sample()
    Dim i As Long, j As Long, k As Long, l As Long
    Dim CountComb As Long, lastrow As Long

    Range("G2").Value = Now

    Application.ScreenUpdating = False

    CountComb = 0: lastrow = 6

    For i = 1 To 4: For j = 1 To 4
    For k = 1 To 8: For l = 1 To 12
        Range("G" & lastrow).Value = Range("A" & i).Value & "/" & _
                                     Range("B" & j).Value & "/" & _
                                     Range("C" & k).Value & "/" & _
                                     Range("D" & l).Value
        lastrow = lastrow + 1
        CountComb = CountComb + 1
    Next: Next
    Next: Next

    Range("G1").Value = CountComb
    Range("G3").Value = Now

    Application.ScreenUpdating = True
End Sub

[〜#〜]スナップショット[〜#〜]

enter image description here

[〜#〜] note [〜#〜]:上記は小さな例です。各200行の4列でテストを行いました。このようなシナリオで可能な合計の組み合わせは1600000000そして16秒かかりました。

このような場合、Excelの行数の制限を超えます。私が考えることができるもう1つのオプションは、そのようなシナリオでテキストファイルに出力を書き込むことです。データが小さい場合は、配列を使用せずにセルに直接書き込むことなく、問題を回避できます。 :)しかし、大きなデータの場合は、配列の使用をお勧めします。

10
Siddharth Rout

私はこれを数回自分で必要として、ついにそれを作りました。

コードは、列の合計数および列内の個別の値の数に応じてスケーリングされると思います(たとえば、各列には任意の数の値を含めることができます)

各列のすべての値が一意であることを前提としています(これが当てはまらない場合、行が重複します)

現在選択しているセルに基づいて出力をクロス結合することを前提としています(必ずすべてを選択してください)。

現在の選択範囲の1列後に出力を開始することを想定しています。

仕組み(簡単に):最初に各列および各行について:N列のすべてのコンボをサポートするために必要な合計行数を計算します(列1の項目*列2の項目... *列Nの項目)

各列の2番目:合計コンボ、および前の列の合計コンボに基づいて、2つのループを計算します。

ValueCycles(現在の列のすべての値を循環する必要がある回数)ValueRepeats(列の各値を連続して繰り返す回数)

Sub sub_CrossJoin()

Dim rg_Selection As Range
Dim rg_Col As Range
Dim rg_Row As Range
Dim rg_Cell As Range
Dim rg_DestinationCol As Range
Dim rg_DestinationCell As Range
Dim int_PriorCombos As Long
Dim int_TotalCombos As Long
Dim int_ValueRowCount As Long
Dim int_ValueRepeats As Long
Dim int_ValueRepeater As Long
Dim int_ValueCycles As Long
Dim int_ValueCycler As Long

int_TotalCombos = 1
int_PriorCombos = 1
int_ValueRowCount = 0
int_ValueCycler = 0
int_ValueRepeater = 0

Set rg_Selection = Selection
Set rg_DestinationCol = rg_Selection.Cells(1, 1)
Set rg_DestinationCol = rg_DestinationCol.Offset(0, rg_Selection.Columns.Count)

'get total combos
For Each rg_Col In rg_Selection.Columns
    int_ValueRowCount = 0
    For Each rg_Row In rg_Col.Cells
        If rg_Row.Value = "" Then
            Exit For
        End If
        int_ValueRowCount = int_ValueRowCount + 1
    Next rg_Row
    int_TotalCombos = int_TotalCombos * int_ValueRowCount
Next rg_Col

int_ValueRowCount = 0

'for each column, calculate the repeats needed for each row value and then populate the destination
For Each rg_Col In rg_Selection.Columns
    int_ValueRowCount = 0
    For Each rg_Row In rg_Col.Cells
        If rg_Row.Value = "" Then
            Exit For
        End If
        int_ValueRowCount = int_ValueRowCount + 1
    Next rg_Row
    int_PriorCombos = int_PriorCombos * int_ValueRowCount
    int_ValueRepeats = int_TotalCombos / int_PriorCombos


    int_ValueCycles = (int_TotalCombos / int_ValueRepeats) / int_ValueRowCount
    int_ValueCycler = 0

    int_ValueRepeater = 0

    Set rg_DestinationCell = rg_DestinationCol

    For int_ValueCycler = 1 To int_ValueCycles
        For Each rg_Row In rg_Col.Cells
            If rg_Row.Value = "" Then
                Exit For
            End If

                For int_ValueRepeater = 1 To int_ValueRepeats
                    rg_DestinationCell.Value = rg_Row.Value
                    Set rg_DestinationCell = rg_DestinationCell.Offset(1, 0)
                Next int_ValueRepeater

        Next rg_Row
    Next int_ValueCycler

    Set rg_DestinationCol = rg_DestinationCol.Offset(0, 1)
Next rg_Col
End Sub
4
spioter

私の2番目のコメントに基づく解決策。この例では、データの列が3つあることを前提としていますが、より多くのデータを処理するように調整できます。

私はあなたのサンプルデータから始めます。便宜上、上の行にカウントを追加しました。また、組み合わせの総数(カウントの積)も追加しました。これはSheet1です:

enter image description here

Sheet2

enter image description here

式:

A2:C2(オレンジ色のセル)はハードコードされています=0

A3=IF(SUM(B3:C3)=0,MOD(A2+1,Sheet1!$E$1),A2)

B3=IF(C3=0,MOD(B2+1,Sheet1!$G$1),B2)

C3=MOD(C2+1,Sheet1!$J$1)

D2=INDEX(Sheet1!$E$2:$E$5,Sheet2!A2+1)

E2=INDEX(Sheet1!$G$2:$G$6,Sheet2!B2+1)

F2=INDEX(Sheet1!$J$2:$J$5,Sheet2!C2+1)

Sheet1に表示されるTotalと同じ数の行を3行目から入力します

3
andy holaday

メソッドを呼び出し、現在のレベルに入れます。これはメソッドで減分されます(engで申し訳ありません)

サンプル:

    sub MyAdd(i as integer)
      if i > 1 then
        MyAdd = i + MyAdd(i-1)
      else
        MyAdd = 1
      end if
    end sub
0
NDavid RU