エクセルVBAで、全ての組み合わせを表現する方法を教えてください
既にA列に色、B列に数字、C列にサイズが入力済みだとします
A B C
1 色 数字 サイズ ←タイトルの行
2 赤 1 S
3 青 2 M
4 緑 3 L
(完成例)
D E F
1 色 数字 サイズ ←タイトルの行
2 赤 1 S
3 赤 1 M
4 赤 1 L
5 赤 2 S
6 赤 2 M
7 赤 2 L
8 赤 3 S
9 赤 3 M
10 赤 3 L
11 青 1 S
12 青 1 M
13 青 1 L
14 青 2 S
15 青 2 M
16 青 2 L
17 青 3 S
18 青 3 M
19 青 3 L
20 緑 1 S
21 緑 1 M
22 緑 1 L
23 緑 2 S
24 緑 2 M
25 緑 2 L
26 緑 3 S
27 緑 3 M
28 緑 3 L
・全ての組み合わせが表現できていれば、2~28行目は上の完成例の順番でなくてもいいです
・完成はD~F列の上から(2行目から)結果を反映させ、空白行を作らないようにする
・今回はA~C列の4行まで入力されている例をあげましたが、実際はA~C列の何行まで入力されているか随時変更します
・A~C列のデータ入力は、必ず上から(2行目から)されています
・A~C列のデータ入力は、5行目以降に続くこともあります
・A~C列のデータ入力は、データがない場合もあります
(データ入力がない場合)
A B C
1 色 数字 サイズ ←タイトルの行
2 1 S
3 2 M
4 L
(この場合の完成例)
D E F
1 色 数字 サイズ ←タイトルの行
2 1 S
3 1 M
4 1 L
5 2 S
6 2 M
7 2 L
空白行が出来てしまってはいけないので、『まずデータ入力されている列を認識し、認識した列の情報で全ての組み合わせを作成する』という考え方なのかな?と思ったのですが、そのようなことをエクセルVBAでできるのでしょうか
もし分かる方がいたら教えてください
よろしくお願いします
A 回答 (7件)
- 最新から表示
- 回答順に表示
No.7
- 回答日時:
関数だと速いのかなあ なんて思いから ちょっとやってみました
Sub 並べるXL2003()
Dim n As Long
Dim n2 As Long
Dim n3 As Long
Dim n4 As Long
Range("D1").Formula = "=IF(A2="""","""",COUNTA(A:A)-1)"
Range("E1").Formula = "=IF(B2="""","""",COUNTA(B:B)-1)"
Range("F1").Formula = "=IF(C2="""","""",COUNTA(C:C)-1)"
Range("G1").Formula = "=PRODUCT(E1,F1)"
Range("H1").Formula = "=PRODUCT(D1:F1)"
If Range("H1") > 65535 * 4 Then Exit Sub
n = WorksheetFunction.Min(Range("H1") + 1, 65536)
Range("D2:D" & n).Formula = "=INDEX(A:A,2+(ROW()-2)/G$1)"
Range("D2:D" & n).Value = Range("D2:D" & n).Value
Range("E2:E" & n).Formula = "=INDEX(B:B,2+MOD((ROW()-2)/F$1,E$1))"
Range("E2:E" & n).Value = Range("E2:E" & n).Value
Range("F2:F" & n).Formula = "=INDEX(C:C,2+MOD(ROW()-2,F$1))"
Range("F2:F" & n).Value = Range("F2:F" & n).Value
If Range("H1") <= 65535 Then Exit Sub
n2 = WorksheetFunction.Min(Range("H1") - 65535 + 1, 65536)
Range("G2:G" & n2).Formula = "=INDEX(A:A,2+(ROW()-2+65535)/G$1)"
Range("G2:G" & n2).Value = Range("G2:G" & n2).Value
Range("H2:H" & n2).Formula = "=INDEX(B:B,2+MOD((ROW()-2+65535)/F$1,E$1))"
Range("H2:H" & n2).Value = Range("H2:H" & n2).Value
Range("I2:I" & n2).Formula = "=INDEX(C:C,2+MOD(ROW()-2+65535,F$1))"
Range("I2:I" & n2).Value = Range("I2:I" & n2).Value
If Range("H1") <= 65535 * 2 Then Exit Sub
n3 = WorksheetFunction.Min(Range("H1") - 65535 * 2 + 1, 65536)
Range("J2:J" & n3).Formula = "=INDEX(A:A,2+(ROW()-2+65535*2)/G$1)"
Range("J2:J" & n3).Value = Range("J2:J" & n2).Value
Range("K2:K" & n3).Formula = "=INDEX(B:B,2+MOD((ROW()-2+65535*2)/F$1,E$1))"
Range("K2:K" & n3).Value = Range("K2:K" & n2).Value
Range("L2:L" & n3).Formula = "=INDEX(C:C,2+MOD(ROW()-2+65535*2,F$1))"
Range("L2:L" & n3).Value = Range("L2:L" & n2).Value
n4 = WorksheetFunction.Min(Range("H1") - 65535 * 3 + 1, 65536)
Range("M2:M" & n4).Formula = "=INDEX(A:A,2+(ROW()-2+65535*3)/G$1)"
Range("M2:M" & n4).Value = Range("M2:M" & n2).Value
Range("N2:N" & n4).Formula = "=INDEX(B:B,2+MOD((ROW()-2+65535*3)/F$1,E$1))"
Range("N2:N" & n4).Value = Range("N2:N" & n2).Value
Range("O2:O" & n4).Formula = "=INDEX(C:C,2+MOD(ROW()-2+65535*3,F$1))"
Range("O2:O" & n4).Value = Range("O2:O" & n2).Value
End Sub
約25万件になるデータが11秒ほどでできました
遊びですがf(^^;
No.6
- 回答日時:
No.5です。
たびたびごめんなさい。
前回の
>No.1さんの補足に
は
>No.2さんの
の間違いです。ごめんなさい。
それと、前回のコードはA~C列の1行目からデータがある!という前提のコードでしたが
1行目は項目行になっていてデータは2行目からあるのですよね?
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To Cells(Rows.Count, "B").End(xlUp).Row
For k = 1 To Cells(Rows.Count, "C").End(xlUp).Row
の3行の「1」をすべて「2」に変更してください。
どうも失礼しました。m(_ _)m
No.5
- 回答日時:
こんにちは!
横からお邪魔します。
No.1さんの補足に
>今のところ、最大で238,238の組み合わせが生じそうです
とありますので・・・
Sub Sample1()
Dim i As Long, j As Long, k As Long, cnt As Long, myRow As Long, myCol As Long, endCol As Long
endCol = ActiveSheet.UsedRange.Columns.Count
If endCol > 3 Then
Range(Columns(4), Columns(endCol)).ClearContents
End If
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To Cells(Rows.Count, "B").End(xlUp).Row
For k = 1 To Cells(Rows.Count, "C").End(xlUp).Row
cnt = cnt + 1
If cnt Mod 65536 = 0 Then
myRow = 65536
myCol = Int(cnt / 65536) * 3 + 1
Else
myRow = cnt Mod 65536
myCol = (Int(cnt / 65536) + 1) * 3 + 1
End If
With Cells(myRow, myCol)
.Value = Cells(i, "A")
.Offset(, 1) = Cells(j, "B")
.Offset(, 2) = Cells(k, "C")
End With
Next k
Next j
Next i
MsgBox "処理完了"
End Sub
※ じっくり考えれば1セルずつ舐めるように表示させるより、一定範囲をコピー&ペーストすれば
もっと早くなると思いますが、65536行目がどこで終わるか?の判断が難しくなりますので、
単純にずらぁ~~~!っと並べています。
腕組みをしてじっくり画面とにらめっこしてください。m(_ _)m
No.4
- 回答日時:
んじゃまぁついでに。
sub macro1for2003()
dim c1 as long, c2 as long, c3 as long
dim r as long
dim w as worksheet
set w = activesheet
range("D:F").clearcontents
range("A1:C1").copy range("D1")
r = 2
for c1 = 2 to application.max(2, w.cells(rows.count, "A").end(xlup).row)
for c2 = 2 to application.max(2, w.cells(rows.count, "B").end(xlup).row)
for c3 = 2 to application.max(2, w.cells(rows.count, "C").end(xlup).row)
if r > 65536 then
worksheets.add after:=activesheet
w.range("A1:C1").copy range("D1")
r = 2
end if
cells(r, "D").value = w.cells(c1, "A").value
cells(r, "E").value = w.cells(c2, "B").value
cells(r, "F").value = w.cells(c3, "C").value
r = r + 1
next c3
next c2
next c1
end sub
言わずもがなですが、わざわざ65536までひっぱる必要は勿論ありません。
もっとも10万行を超える書き出しを逐一行ってると、随分とろくさいですけどね。
2003用までありがとうございます
このようなコードを作成したおことがないのですが、最終行までいくと、新しいシートが作成させるのでしょうか?
できれば一つのシートで完成させたいので、(1)エクセル2003では使用しない、(2)入力できるデータ数を制限する、で何とか1つのシートで完成しようと思います
本当に助かりました
No.3
- 回答日時:
>●=2は何を意味するのでしょうか?
ABC列に記入が無い場合の対処です。
>■で65536を使わずにできないかな?と思い
現実問題としてABC列に6万を超える「リストの元ネタ」を、本当に並べるつもりがあるのですか?(DEF列の事じゃ勿論ありませんよ)
もしマジメにそうする必要があってそうしたいと言うのでしたら、勿論そのように対処してください。
ふつーに考えると「A9999」とかでも全然十分だと思ってましたけどね。
sub macro1r1()
dim c1 as long, c2 as long, c3 as long
dim r as long
range("D:F").clearcontents
range("A1:C1").copy range("D1")
r = 2
for c1 = 2 to application.max(2, cells(rows.count, "A").end(xlup).row)
for c2 = 2 to application.max(2, cells(rows.count, "B").end(xlup).row)
for c3 = 2 to application.max(2, cells(rows.count, "C").end(xlup).row)
cells(r, "D").value = cells(c1, "A").value
cells(r, "E").value = cells(c2, "B").value
cells(r, "F").value = cells(c3, "C").value
r = r + 1
next c3
next c2
next c1
end sub
分かりやすい説明ありがとうございます
後になり、Cells(Rows.Count, 1).End(xlUp).Row
で解決すると気が付きました
ありがとうございます
No.2
- 回答日時:
基本的には No.1 さんの方法でいいと思いますが、シートの最大の行数に注意してください。
Excel 2003 以前で 65,536、Excel 2007 以後で 1,048,576 です。組み合わせの数は、爆発的に増加します。質問文の例だと色・数字・サイズという 3 属性が 3 種類ずつなので、組み合わせの数は 3^3 = 27 通りとなりますね。
しかし 41 種類ずつだと 41^3 = 68,921、102 種類ずつだと 102^3 = 1,061,208 となって、すぐに制限を超えてしまいます。他にも例えば、色・数字・サイズが 20・350・10 であれば 20 x 350 x 10 = 70,000、120・1,000・10 であれば 120 x 1,000 x 10 = 1,200,000 などとなり、やはりオーバーします。
ですから制限を超えそうな場合は、途中で列を変えて続きを記入していくなどの工夫が必要になります。コード中、For の行に記述している行番号の変数(No.1 さんのコードで言えば c1 あたり)の最大値を調節することなどによって、途中で無事に終われます。
そうしておかないと、最大の行数までの記入は実行されますが、その次の記入でマクロがエラーになります。
なおマクロの実行にかかる時間は、環境にもよりますが、100 万行を記入するなら何分かかかると思ってください。
>……、『まずデータ入力されている列を認識し、……と思ったのですが、そのようなことをエクセルVBAでできるのでしょうか
条件に関する必要な情報が十分に与えられれば、その手のことはいくらでも可能だと思います。しかし難しいことをしようとするほど、VBA に関する様々な知識が必要になっていきます。まずは基本の処理を習得し、それ以上のことは追々、学んでいってください。
回答ありがとうございます
今のところ、最大で238,238の組み合わせが生じそうです
既にエクセル2003では超えてしまいますね
また、データが今後増えていくことが予想できるので
エクセル2003で使用できるように、入力できるデータ数を制限するのも一つの手かなと考えています
ありがとうございました
No.1
- 回答日時:
奇をてらわずに、単純にぐるぐる廻してくだけで十分です。
sub macro1()
dim c1 as long, c2 as long, c3 as long
dim r as long
range("D:F").clearcontents
range("A1:C1").copy range("D1")
r = 2
for c1 = 2 to application.max(2, range("A65536").end(xlup).row)
for c2 = 2 to application.max(2, range("B65536").end(xlup).row)
for c3 = 2 to application.max(2, range("C65536").end(xlup).row)
cells(r, "D").value = cells(c1, "A").value
cells(r, "E").value = cells(c2, "B").value
cells(r, "F").value = cells(c3, "C").value
r = r + 1
next c3
next c2
next c1
end sub
早い回答ありがとうございます
意外と短く表現できるんですね!
助かりました
Application.Max(●, ■)で、最大行を取得しているんだと思うのですが、
●=2は何を意味するのでしょうか?
また、■で65536を使わずにできないかな?と思い
Cells(Rows.Count, 1).End(xlUp) としましたが、うまくいきませんね・・
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
初めて自分の家と他人の家が違う、と意識した時
子供の頃、友達の家に行くと「なんか自分の家と匂いが違うな?」って思いませんでしたか?
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
Excelでの全通りの組み合わせ出力方法(文字列)
Excel(エクセル)
-
Excelマクロでのデータ全通り組み合わせ出力方法
Excel(エクセル)
-
Excelですべての組合せ(重複組合せ)を出力するには?
Visual Basic(VBA)
-
-
4
Excelでデータ全通り組み合わせ出力方法
Excel(エクセル)
-
5
配列の参照渡しで型が一致しません。
Visual Basic(VBA)
-
6
エクセルVBAで、特定の数字になる組み合わせを知りたいのですが・・・
Excel(エクセル)
-
7
エクセルで重複しない組み合わせ出力方法
Excel(エクセル)
-
8
エクセルで重複しない組み合わせの出し方
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの警告について
-
エクセル 入力があった場合のみ...
-
エクセルの関数
-
Excelでの勤怠表の関数を教えて...
-
【Excel】効率的な関数式の組み...
-
エクセルの数式について教えて...
-
Excelの更新日時が自動で更新さ...
-
考えた式の戻り値が期待通りに...
-
(マクロ)参照渡しにて、違う...
-
if関数。半角文字や全角文字で...
-
エクセルを使ってQRコードを作...
-
FからI列で期限切れ及び期限7日...
-
(マクロ)値を返す時は subで...
-
ExcelやLibreOffice Calcの関数...
-
エクセルでファイルの最終更新...
-
EXCELの散布図で日付が1900年に...
-
エクセルについての質問です。 ...
-
エクセルの数式バーのフォント...
-
【Excel】 1つのセルの日にちを...
-
Excelの計算が合いません。 諸...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの警告について
-
エクセルデーターから必要な項...
-
エクセルでファイルの最終更新...
-
複数のテキストファイルをexcel...
-
Excelの複数条件の関数
-
【マクロ】ファイル名の一括変...
-
EXCELの散布図で日付が1900年に...
-
マクロの処理が遅くなった
-
Excelの時刻の不思議
-
エクセルでの2項目比較および...
-
Excelマクロで空白セルを詰めて...
-
エクセルの数式バーのフォント...
-
ExcelでASCを使って全角を半角...
-
エクセルで80万行、50列位のデ...
-
今まで文字化けなく開けていたc...
-
エクセルのことで教えてくださ...
-
エクセルVBA 月の中で、月~土...
-
Excelでの表の作り方
-
Excel セルにおけるフォント設...
-
エクセルの質問です。 F列からL...
おすすめ情報