5×5のセルに数字を入力してVBAを実行する方法

このQ&Aのポイント
  • 5×5のセルに数字を入力し、ボタンを押すことで53,130通りの組み合わせを作成する方法について質問です。
  • 現在はVBAソースを手動で変更しなければならないため、手間がかかっています。
  • どのようにVBAのソースを修正すれば、5×5のセルに入力した数字に応じて自動的に組み合わせを作成できるでしょうか?
回答を見る
  • ベストアンサー

5×5のセルに入力した数字を配列に格納する方法

どなたかご存じでしたらご回答をお願いします。 【質問】 下記のVBAを実行すると、「異なる 25個のものから 5個を選ぶ組み合わせ の総数 nCr (53,130通り)」を作成します。毎回、VBAソースの25個の配列の値を変更して 実行しておりますが少々手間です。これを5×5のセルの中に25個の数字を入力して ボタン押下にてVBAを実行すると、53,130通りの組み合わせを作成するようにするには 下記VBAのソースはどのように修正すればよいでしょうか? ●VBAソース Sub test() Const MaxNum = 25 Dim s(25) As String s(1) = "1" s(2) = "2" s(3) = "3" s(4) = "4" s(5) = "5" s(6) = "6" s(7) = "7" s(8) = "8" s(9) = "9" s(10) = "10" s(11) = "11" s(12) = "12" s(13) = "13" s(14) = "14" s(15) = "15" s(16) = "16" s(17) = "17" s(18) = "18" s(19) = "19" s(20) = "20" s(21) = "21" s(22) = "22" s(23) = "23" s(24) = "24" s(25) = "25" Dim i, j, k, l, m Dim rowX As Long rowX = 1 rowX = rowX + 1 For i = 1 To MaxNum - 4 For j = i + 1 To MaxNum - 3 For k = j + 1 To MaxNum - 2 For l = k + 1 To MaxNum - 1 For m = l + 1 To MaxNum Cells(rowX, 1).Value = s(i) Cells(rowX, 2).Value = s(j) Cells(rowX, 3).Value = s(k) Cells(rowX, 4).Value = s(l) Cells(rowX, 5).Value = s(m) rowX = rowX + 1 Next m Next l Next k Next j Next i End Sub ●VBAの実行結果 A     B     C     D    E  1     2     3     4     5 1     2     3     4     6 1     2     3     4     7 1     2     3     4     8 1     2     3     4     9 1     2     3     4     10 1     2     3     4     11 1     2     3     4     12 1     2     3     4     13 1     2     3     4     14             :             : 20    21    22     24    25 20    21    23     24    25 20    22    23     24    25 21    22    23     24    25   【注意事項】   ・使用するエクセルは2010です。 以上、よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • NNori
  • ベストアンサー率22% (377/1669)
回答No.1

値をいれるところが面倒とお考えなようなので、そこを変更してみましょう。 s(1) = "1" s(2) = "2" s(3) = "3" s(4) = "4" s(5) = "5" s(6) = "6" s(7) = "7"   ... s(24) = "24" s(25) = "25" の部分を変更します。 dim i as integer dim r as integer dim c as integer i = 1 for r = 1 to 5  for c = 1 to 5   s(i) = cells(r,c).value   i = i + 1  next next i で配列をいじっちゃうのがちょっとエレガントでないです。 私ならこう書きます。Loop の for~next は0から回したほうが考えやすいのです。 dim r as integer dim c as integer for r = 0 to 4  for c = 0 to 4   s(r*5+c+1) = cells( r+1,c+1).value  next next

moguo4649
質問者

お礼

早速のご回答ありがとうございます。 教えて頂いた変更点でソース修正してみて 5×5のセルに25個数字を入れて 実行したところ上手くでました。 これで入力が楽になりました。 ありがとうございました。

関連するQ&A

  • セルの数字を配列に格納するためのVBAソースは?

    どなたかご存知でしたらご教授願います。 以前、こちらの相談室にて、エクセルで「25C5」という組み合わせを作成するVBAソース を見つけました。これを少し改造して下記のようなソースにしました。 【25C5を作成するソース】 Sub test() Const MaxNum = 25 Dim s(25) As String s(1) = "9" s(2) = "10" s(3) = "19" s(4) = "23" s(5) = "25" s(6) = "8" s(7) = "17" s(8) = "22" s(9) = "24" s(10) = "31" s(11) = "6" s(12) = "7" s(13) = "16" s(14) = "18" s(15) = "21" s(16) = "4" s(17) = "14" s(18) = "15" s(19) = "29" s(20) = "30" s(21) = "2" s(22) = "12" s(23) = "13" s(24) = "27" s(25) = "28" Dim i, j, k, l, m Dim rowX As Long rowX = 1 rowX = rowX + 1 For i = 1 To MaxNum - 4 For j = i + 1 To MaxNum - 3 For k = j + 1 To MaxNum - 2 For l = k + 1 To MaxNum - 1 For m = l + 1 To MaxNum Cells(rowX, 1).Value = s(i) Cells(rowX, 2).Value = s(j) Cells(rowX, 3).Value = s(k) Cells(rowX, 4).Value = s(l) Cells(rowX, 5).Value = s(m) rowX = rowX + 1 Next m Next l Next k Next j Next i End Sub ここで質問ですが、上記ソースの配列は25個(S(1)~S(25))あります。 現在は上記ソースの配列1つずつに毎回直接数字を設定しております。 これが面倒くさいので、下記のようにセルに貼り付けをしたら、 それを自動で配列に格納して、上記ソースへと連動させるためのVBAソースは どうやって記述すればよいですか? 【セルに貼り付ける数字】 9     10     19    23     25 8     17     22    24     31 6     7      16    18     21 4     14     15    29     30 2     12     13    27     28 ●注意事項   (1)セルに貼り付ける数字の値は毎回異なりますが、5×5は毎回同じです。   (2)使用するエクセルは2010です。 以上

  • 合計値がある範囲の場合に印をつけるには?

    どなたかご存じでしたらご回答をお願いします。 【質問】 下記のVBAを実行すると、「異なる 25個のものから 5個を選ぶ組み合わせ の総数 nCr (53,130通り)」を作成します。A列~E列の合計をF列に表示しておりますが、 F列の値が58~102の場合、G列に”●”をつけるには、 下記VBAのソースはどのように修正すればよいでしょうか? ●VBAソース ub test() Const MaxNum = 25 Dim s(25) As String Dim i As Integer Dim r As Integer Dim c As Integer i = 1 For r = 1 To 5 For c = 1 To 5 s(i) = Cells(r, c).Value i = i + 1 Next Next Dim j, k, l, m Dim rowX As Long rowX = 0 rowX = rowX + 1 For i = 1 To MaxNum - 4 For j = i + 1 To MaxNum - 3 For k = j + 1 To MaxNum - 2 For l = k + 1 To MaxNum - 1 For m = l + 1 To MaxNum Cells(rowX, 1).Value = s(i) Cells(rowX, 2).Value = s(j) Cells(rowX, 3).Value = s(k) Cells(rowX, 4).Value = s(l) Cells(rowX, 5).Value = s(m) Cells(rowX, 6).Value = Application.WorksheetFunction.Sum(s(i), s(j), s(k), s(l), s(m)) rowX = rowX + 1 Next m Next l Next k Next j Next i End Sub ●VBA実行結果(やりたいこと) A    B     C     D     E     F  G 1     2     3     4     5     15       1     2     3     4     6     16       1     2     3     4     7     17  1     2     3     4     8     18 1     2     3     4     9     19             :             : 1     5     12    19     20    57 1     5     12    19     21    58  ● 1     5     12    19     22    59  ● 1     5     12    19     23    60  ●             :             : 20    21    22     24    25    112 20    21    23     24    25    113 20    22    23     24    25    114 21    22    23     24    25    115   【注意事項】   ・使用するエクセルは2010です。 以上、よろしくお願いします。

  • A列~E列の合計数をF列に表示させる。

    どなたかご存じでしたらご回答をお願いします。 【質問】 下記のVBAを実行すると、「異なる 25個のものから 5個を選ぶ組み合わせ の総数 nCr (53,130通り)」を作成します。A列~E列の合計をF列に表示させるには 下記VBAのソースはどのように修正すればよいでしょうか? 教えてください。 ●VBAソース Sub test() Const MaxNum = 25 Dim s(25) As String s(1) = "1" s(2) = "2" s(3) = "3" s(4) = "4" s(5) = "5" s(6) = "6" s(7) = "7" s(8) = "8" s(9) = "9" s(10) = "10" s(11) = "11" s(12) = "12" s(13) = "13" s(14) = "14" s(15) = "15" s(16) = "16" s(17) = "17" s(18) = "18" s(19) = "19" s(20) = "20" s(21) = "21" s(22) = "22" s(23) = "23" s(24) = "24" s(25) = "25" Dim i, j, k, l, m Dim rowX As Long rowX = 1 rowX = rowX + 1 For i = 1 To MaxNum - 4 For j = i + 1 To MaxNum - 3 For k = j + 1 To MaxNum - 2 For l = k + 1 To MaxNum - 1 For m = l + 1 To MaxNum Cells(rowX, 1).Value = s(i) Cells(rowX, 2).Value = s(j) Cells(rowX, 3).Value = s(k) Cells(rowX, 4).Value = s(l) Cells(rowX, 5).Value = s(m) rowX = rowX + 1 Next m Next l Next k Next j Next i End Sub ●現在のVBAの実行結果 A     B     C     D    E  1     2     3     4     5 1     2     3     4     6 1     2     3     4     7 1     2     3     4     8 1     2     3     4     9 1     2     3     4     10 1     2     3     4     11 1     2     3     4     12 1     2     3     4     13 1     2     3     4     14            :            : 20    21    22     24    25 20    21    23     24    25 20    22    23     24    25 21    22    23     24    25 ●VBA実行結果(F列:A列~E列の合計) <- やりたいこと A    B     C     D    E     F 1     2     3     4     5     15      1     2     3     4     6     16      1     2     3     4     7     17 1     2     3     4     8     18 1     2     3     4     9     19 1     2     3     4     10     20 1     2     3     4     11     21 1     2     3     4     12     22 1     2     3     4     13     23 1     2     3     4     14     24            :            : 20    21    22     24    25     112 20    21    23     24    25     113 20    22    23     24    25     114 21    22    23     24    25     115   【注意事項】   ・使用するエクセルは2010です。 以上、よろしくお願いします。

  • エクセルVBAの配列について

    エクセルVBAの配列について VBAをはじめたばかりの初心者です。 現在、下記のようにデータを配列の中に入れ、 別シートに書き出そうとしております。 (配列へ読み込むところのみ) Dim 配列(1 To 件数, 1 To 9) As Variant For j =1 To 件数 For i = 2 To L If Cells(i, 2).Value = Tx_month Then For k = 3 To 11 配列(j, k - 2) = Cells(i, k).Value Next k End If Next j,i 現状では、データの最終行のみを「件数」分書き出してしまいます。 jとiのForが重なっているからだと思うのですが、どう書き直したら良いか分かりません。 質問をさせていただくのも初めてなので、分かりづらく恐縮ですが お力添え頂けますと幸いです。 どうぞ宜しくお願い致します。

  • VBAtest

    VBAおn以下の Sheets("OP").Select Dim atai As String atai = Cells(2, 2).Value Dim datedata(40) As String For j = 0 To 40 If Cells(j + 3, 2).Value = "" Then Else datedata(j) = Cells(j + 3, 2).Value End If Next Dim shihyou As String For i = 1 To 2 shihyou = Cells(2, i + 2).Cells.Value Sheets(shihyou).Select Dim tmp_c As Integer For r = 1 To 10 tmp_c = 0 For c = 1 To 10 If tmp_c = 0 Then If Sheets(shihyou).Cells(r, c).Value = atai Then tmp_c = c End If Else Dim vals(40) As String For k = 0 To 40 For l = 1 To r + 41 For m = 1 To tmp_c - 1 If Sheets(shihyou).Cells(l, m).Value = datedata(k) Then vals(k) = Sheets(shihyou).Cells(l, tmp_c).Value End If Next Next Next End If Next Next Sheets("OP").Select For k = 3 To 43 Cells(k, i + 2).Value = vals(k - 3) Next Next End Sub

  • データ検索ネスト Excel VBA

    excel2003でデータ検索の処理をするというマクロをVBAで作成したいのですが、うまく動作しません。自作のVBAを記載してみましたので何が原因なのか教えてください。初心者です、よろしくお願いします。 Sub データ検索() Dim i As Integer, j As Integer, k As Integer, l As Integer Dim myRange As Range Dim IngLastrow As Long IngLastrow = Range("A65536").End(xlUp).Row For i = 3 To IngLastrow For j = 3 To 25 For k = 8 To 53 For l = 3 To 9 Set myRange = Worksheets("データベース").Cells(i, "o").Find(what:=Worksheets("コード").Cells(j, "o").Value, _ LookIn:=xlValues) If Not myRange Is Nothing Then Worksheets("予定").Cells(k, l).Value = myRange.Offset(, -12).Value End If Next l Next k Next j Next i End Sub

  • エクセルVBA、ステップモードと結果が異なる

    たとえば、 dim i,j,k as integer for i=1 to 10 for j=1 to 1000 for k=1 to 100 cells(i*1000+j,k).value=worksheets(i).cells(j,k).value next k next j next i みたいなものを実行させると、転記する行がずれることってありますでしょうか。 F8キーを押し続けて一行ずつ実行させたときには問題ないのですが、普通に実行させたときと結果が異なります。 本当はもっと複雑なプログラムを走らせているのですが、決まって同じセルでおかしな値が入力されてしまうのです。 同じような経験をされた方とか、解決方法をご存じの方、よろしくお願いします。

  • EXCEL VBAのFor...Nextについて

    VBA初心者です。よく理解していませんので、質問も的を得ていないかもしれませんが、ご指導宜しくお願いいたします。  現在、For...Nextを使った表計算をしています。 A列に「す」という文字が含まれていたら、B列の「す」の行に「あ」と「い」と「え」「か」のセルの合計をだす。C列、D列・・・最終列まで計算する。 上記VBAを作成する方法を教えて下さい。 A  B  C  D  E   F  G  H  I  J  K  L 1 2    3    4   5    6    7    8    9    10    11 12 あ  1 2 3 4   5 6 7 8 9 10 11 い 10 20 30 40  50 60 70 80 90 100 110 う 20 30 40 50   60 70 80 90 100 110 120 え 40 50   60  70 80 90  10 20 120 130 30 お 50 60   70  80 90 10  20 30 130 140 40 か 60 70   80  90 10 20  30 40 140 150 50 す 私は表に1~12まで数字をインプットし下記のようなコードを考えました。 Sub 列合計() Dim i, k, l, m, n As Long j = 2 For i = 6 To 120 For k = 6 To 120 For l = 6 To 120 For m = 6 To 120 For n = 6 To 120 If Cells(i, 1) = "す" And Cells(k, 1) = "あ" And Cells(l, 1) = "い" And Cells(m, 1) = "え" And Cells(n, 1) = "か" Then Do While j <= Range("A2").End(xlToRight) Cells(i, j) = Cells(k, j) + Cells(l, j) + Cells(m, j) + Cells(n, j) j = j + 1 Loop Else: End If Next n Next m Next l Next k Next i End Sub この内容だとエラーが出てしまいます。 補足ですが、あいうえおかの順番はかわったり、間に他の行が入ったりします。 また今回はL列の間としましたが、もっと列が増え、最終列まで計算する方法を知りたいのですが、どうぞ宜しくお願い致します。 ※ofice2013です。

  • VBAで、配列のデータをセルに書き戻す方法について

    1000行200列の配列があり、配列の5列目と6列目のデータを、セルの10列目と11列目にすばやく書き戻す方法を教えてください。 (方法1) Dim DATA() As Long ReDim DATA(1 To 1000, 1 To 200) FOR 行番号= 1 TO 1000 CELLS(行番号,10).VALUE = DATA(行番号,5) CELLS(行番号,11).VALUE = DATA(行番号,6) NEXT (方法2) Dim DATA() As Long ReDim DATA(1 To 1000, 1 To 200) Dim WORK1() As Long ReDim WORK1(1 To 1000, 1 To 1) Dim WORK2() As Long ReDim WORK2(1 To 1000, 1 To 1) FOR 行番号= 1 TO 1000 WORK1(行番号,1) = DATA(行番号,5) WORK2(行番号,1) = DATA(行番号,6) NEXT RANGE("J1:J1000").VALUE = WORK1() RANGE("K1:K1000").VALUE = WORK2() (方法1)より(方法2)の方が早いのですが、WORKに貯めるのもめんどうなので、 RANGE("J1:K1000").VALUE = DATA(1,5), DATA(2,5), DATA(3,5),~,DATA(999,6),DATA(1000,6)のようなことができればと思います。 よろしくお願いします。

  • ExcelのVBAがオーバーフローに!?

    読んで頂きありがとうございます。 以前に質問しました時に回答を頂き凄く助かっていたのですが、何故か「オーバーフロー」と表示されてしまいます。 ひょっとしたら桁なのかも知れません。 下記のVBAを教えて頂きしようしていました。 Option Explicit Sub Test() Dim c(), p(), q(), i, j, l, r, k As Long r = Range("B2").End(xlDown).Row l = Range("D2").End(xlDown).Row ReDim c(r - 2), p(r - 2), q(r - 2) For i = 1 To r - 2 c(i) = Cells(i + 2, 2).Value p(i) = Cells(i + 2, 3).Value q(i) = i + 2 Next i For i = 1 To r - 3 For j = i + 1 To r - 2 If c(i) > c(j) Then k = c(i) c(i) = c(j) c(j) = k k = p(i) p(i) = p(j) p(j) = k k = q(i) q(i) = q(j) q(j) = k End If Next j Next i For i = 1 To r - 2 Cells(i + 2, 7).Value = c(i) For j = 3 To r If Cells(j, 4).Value = c(i) Then Cells(i + 2, 8).Value = p(i) - Cells(j, 5).Value If p(i) - Cells(j, 5).Value <> 0 Then Range("B" & q(i)).Interior.ColorIndex = 6 Range("D" & j).Interior.ColorIndex = 6 End If Exit For End If Next j Next i For i = 3 To r k = 0 For j = 3 To l If Cells(i, 2).Value = Cells(j, 4).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("B" & i).Interior.ColorIndex = 35 End If Next i For i = 3 To l k = 0 For j = 3 To r If Cells(i, 4).Value = Cells(j, 2).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("D" & i).Interior.ColorIndex = 35 End If Next i End Sub デパックのClickすると15行目辺りの「k = c(i)」が黄色くなります。 正直言ってマクロとか全く解りませんが、コピーして使っていました。 どこをどう変更すれば良いのか教えて頂ければ助かります。 よろしくお願いします。

専門家に質問してみよう