【ExcelVBA】たくさんの組み合わせを作りたい
知恵袋で質問がありまして、お答えして無事解決したと思っていたら、追加の質問が出ていました。ところがすでに回答は締め切られておりまして、回答したくてもできないので、こちらに書いておきます。
質問の内容
数学か何かの問題なんでしょうか。組み合わせを作りたいという質問でした。
回答
私の回答がこちら。
確かこのときの私の作業記録を見ると、この知恵袋に回答するのに19分かかっています。コードを作ってデバッグして、問題ないことを確認してから回答して・・・だから、多分当時それほど難しいはと思っていなかったんだろうなと思います。
他の人も回答していましたし、割と簡単だったな・・・と思っていました。
追加の質問
ところがこれで終わりではなかったようです。質問主様は追加の質問をしていました。
なんと。組み合わせはこれだけじゃなかったようです。全部で50グループ前後あるとな！
ところがこの追加の質問に私は気がつきませんで、いつの間に回答は締め切られていましたorz
追加の質問というのは、やめてほしいなと思います。たいてい気づきません＞＜
新たに質問を立て直してくれた方がよほど気が付きます。
追加の質問に対する回答
今さらここに書いても質問主様が読むとは限らないのですが、せっかくなので追加の質問に対する回答をこちらに書いておきます。
Public Sub Tasu_Kumiawase()
Dim Sh As Worksheet
Dim vV
Dim ii As Long, jj As Long
Const clNum As Long = 12 '48
Const cstM As String = "・"
Dim stRet As String
Dim vCol(1 To clNum) As Collection
Dim lCnt(1 To clNum) As Variant
Dim a01 As Long, a02 As Long, a03 As Long, a04 As Long, a05 As Long
Dim a06 As Long, a07 As Long, a08 As Long, a09 As Long, a10 As Long
Dim a11 As Long, a12 As Long, a13 As Long, a14 As Long, a15 As Long
Dim a16 As Long, a17 As Long, a18 As Long, a19 As Long, a20 As Long
Dim a21 As Long, a22 As Long, a23 As Long, a24 As Long, a25 As Long
Dim a26 As Long, a27 As Long, a28 As Long, a29 As Long, a30 As Long
Dim a31 As Long, a32 As Long, a33 As Long, a34 As Long, a35 As Long
Dim a36 As Long, a37 As Long, a38 As Long, a39 As Long, a40 As Long
Dim a41 As Long, a42 As Long, a43 As Long, a44 As Long, a45 As Long
Dim a46 As Long, a47 As Long, a48 As Long, a49 As Long, a50 As Long
Dim a51 As Long, a52 As Long, a53 As Long, a54 As Long, a55 As Long
Dim lTotal As Long
Set Sh = ActiveSheet
vV = Sh.Range(Sh.Cells(4, 1), Sh.Cells(7, clNum)).Value
For jj = LBound(vV, 2) To UBound(vV, 2)
For ii = LBound(vV, 1) To UBound(vV, 1)
If ii = LBound(vV, 1) Then Set vCol(jj) = New Collection
If vV(ii, jj) <> "" Then
vCol(jj).Add vV(ii, jj), vV(ii, jj)
End If
Next ii
Next jj
For ii = 1 To clNum
lCnt(ii) = vCol(ii).Count
Next ii
lTotal = 0
For a01 = 1 To lCnt(1)
For a02 = 1 To lCnt(2)
For a03 = 1 To lCnt(3)
For a04 = 1 To lCnt(4)
For a05 = 1 To lCnt(5)
For a06 = 1 To lCnt(6)
For a07 = 1 To lCnt(7)
For a08 = 1 To lCnt(8)
For a09 = 1 To lCnt(9)
For a10 = 1 To lCnt(10)
For a11 = 1 To lCnt(11)
For a12 = 1 To lCnt(12)
'For a13 = 1 To lCnt(13)
'For a14 = 1 To lCnt(14)
'For a15 = 1 To lCnt(15)
'For a16 = 1 To lCnt(16)
'For a17 = 1 To lCnt(17)
'For a18 = 1 To lCnt(18)
'For a19 = 1 To lCnt(19)
'For a20 = 1 To lCnt(20)
'For a21 = 1 To lCnt(21)
'For a22 = 1 To lCnt(22)
'For a23 = 1 To lCnt(23)
'For a24 = 1 To lCnt(24)
'For a25 = 1 To lCnt(25)
'For a26 = 1 To lCnt(26)
'For a27 = 1 To lCnt(27)
'For a28 = 1 To lCnt(28)
'For a29 = 1 To lCnt(29)
'For a30 = 1 To lCnt(30)
'For a31 = 1 To lCnt(31)
'For a32 = 1 To lCnt(32)
'For a33 = 1 To lCnt(33)
'For a34 = 1 To lCnt(34)
'For a35 = 1 To lCnt(35)
'For a36 = 1 To lCnt(36)
'For a37 = 1 To lCnt(37)
'For a38 = 1 To lCnt(38)
'For a39 = 1 To lCnt(39)
'For a40 = 1 To lCnt(40)
'For a41 = 1 To lCnt(41)
'For a42 = 1 To lCnt(42)
'For a43 = 1 To lCnt(43)
'For a44 = 1 To lCnt(44)
'For a45 = 1 To lCnt(45)
'For a46 = 1 To lCnt(46)
'For a47 = 1 To lCnt(47)
'For a48 = 1 To lCnt(48)
'For a49 = 1 To lCnt(49)
'For a50 = 1 To lCnt(50)
'For a51 = 1 To lCnt(51)
'For a52 = 1 To lCnt(52)
'For a53 = 1 To lCnt(53)
'For a54 = 1 To lCnt(54)
'For a55 = 1 To lCnt(55)
stRet = vCol(1)(a01) & cstM & vCol(2)(a02) & cstM & vCol(3)(a03) & cstM & vCol(4)(a04) & cstM & vCol(5)(a05) & cstM & vCol(6)(a06) & cstM & vCol(7)(a07) & cstM & vCol(8)(a08) & cstM & vCol(9)(a09) & cstM & vCol(10)(a10) & cstM & vCol(11)(a11) & cstM & vCol(12)(a12)
'stRet = stRet & cstM & vCol(13)(a13) & cstM & vCol(14)(a14) & cstM & vCol(15)(a15) & cstM & vCol(16)(a16) & cstM & vCol(17)(a17) & cstM & vCol(18)(a18) & cstM & vCol(19)(a19) & cstM & vCol(20)(a20) & cstM & vCol(21)(a21) & cstM & vCol(22)(a22) & cstM
'stRet = stRet & vCol(23)(a23) & cstM & vCol(24)(a24) & cstM & vCol(25)(a25) & cstM & vCol(26)(a26) & cstM & vCol(27)(a27) & cstM & vCol(28)(a28) & cstM & vCol(29)(a29) & cstM & vCol(30)(a30) & cstM & vCol(31)(a31) & cstM & vCol(32)(a32) & cstM
'stRet = stRet & vCol(33)(a33) & cstM & vCol(34)(a34) & cstM & vCol(35)(a35) & cstM & vCol(36)(a36) & cstM & vCol(37)(a37) & cstM & vCol(38)(a38) & cstM & vCol(39)(a39) & cstM & vCol(40)(a40) & cstM & vCol(41)(a41) & cstM & vCol(42)(a42) & cstM
'stRet = stRet & vCol(43)(a43) & cstM & vCol(44)(a44) & cstM & vCol(45)(a45) & cstM & vCol(46)(a46) & cstM & vCol(47)(a47) & cstM & vCol(48)(a48) & cstM
'stRet = stRet & vCol(49)(a49) & cstM & vCol(50)(a50) & cstM & vCol(51)(a51) & cstM & vCol(52)(a52) & cstM & vCol(53)(a53) & cstM & vCol(54)(a54) & cstM & vCol(55)(a55)
Debug.Print stRet
lTotal = lTotal + 1
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
'Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Debug.Print lTotal & "件生成しました"
End Subこのコードに対応するExcelシートはこんな感じです。
解説
データが何件あるか不明なので、Const値として件数を持つようにしました。clNumというLong型の定数がそれです。
For文だけは件数に応じて毎回修正が必要です。Debug.Printする部分も、件数に応じて修正が必要となります。
添え字となるa01~a55は、一度作ってしまえば、あとはそこに存在するだけで悪さはしないので、べた書きしました。
しかし、時間がもったいないので、いちいち手では書いていないですよ？Excelでセルにa01と書いたら、あとはオートフィルで55個生成しています。
こういう繰返し似たようなコードが出てくるプログラムは、Excelで大量生産→秀丸で加工修正→VBEに貼り付けという手順でいつも時間を節約しています。
こういう大量にコードが必要となるVBAは、C言語のテストをアルバイトでやっていたときにさんざんやりました。
もっと頭のよい、洗練されたやり方もあるのかもしれませんが、私にはこれが精いっぱいです。この問題は手ごわかったです。コードを考えて生成して、テストするのに1時間3分かかりました。
注意点
このコードでは、組み合わせ件数は55件ではなく12件だけになっています。
件数を増やすときはclNumを変更するのと、関係各所のコメント化されている部分のコメント化を解除する必要があります。
たった12件の組み合わせですが、私が用意したテストデータだけでも12万件を超えました。これを48件や55件にしたとき、VBAが落ちないかと心配です。
また、組み合わせ結果をイミディエイトペインにしていますが、Excelシート上に吐き出すようにした方がよいでしょう。
しかし、まずはデバッグで何件吐き出すか確認してから、次の段階に進んだ方がよいです。テストデータによっては、1,048,576件を超える可能性もありますから(1,048,576というのはExcelワークシートの最大行数です)。
-
前の記事
【外国人技能実習生】有期雇用契約の期間満了前退職の取扱いについて 2022.06.30
-
次の記事
知恵袋のマナー – 「回答後の追加質問」問題 2022.07.02