アルゴリズムについての質問

このQ&Aのポイント
  • ある建物で各部屋同士の机の移動を行うため、その労力を最小にする組み合わせを求める。
  • 移動する部屋間の労力を表す表があり、最小の組み合わせを探すが処理速度が遅い。
  • 作成したプログラムで処理を遅くしている原因が思いつかないため、アドバイスを求める。
回答を見る
  • ベストアンサー

アルゴリズムについての質問です

アルゴリズムについての質問です。 以下のようなプログラムを考えています。 プログラムの目的 ある建物で各部屋同士の机の移動を行うため、その労力を最小にする組み合わせを求める。 ※このシステムは他の人が使用することを考え、わかりやすいExcel(VBA)を使用しています。 画像に関して <図1>は「No(部屋)」の距離(数字が小さい方が労力が少ない)を表しています。 ※プログラムでこの表は出力されています <図2>のようにA群とB群があり、A群からB群に移動する(複数移動も含む)場合について考えます。 <図3>のような最小の組み合わせを探します。 正しい結果は出るのですが、1件増えるだけで何倍何十倍と時間がかかってしまいます。 多少結果は妥協して(最小に近い値)でも処理を早くしたいと思っていますが、そのアルゴリズムが思いつきません。 作成したプログラムを下記にありますので、アドバイスをお願いいたします。 作成したプログラムで処理を遅くしている原因があれば指摘もお願いします。 ---現在作成したプログラムです。(すべてのパターンを検証)----------------- Dim 重みtab As Variant Dim t01(100) As Integer '←A群が、「t01(1)」から順に入っています。 Dim t02(100) As Integer '←B群が、「t02(1)」から順に入っています。 Dim ttt(100) As Integer '←B群を並び替えた結果が入ります。 Sub 計算(移動数 As Integer) '「移動数」は「t01」「t02」の要素の数 Dim t03(100) As Integer Dim a As Integer 重みtab = Range("重み表") 'Range("重み表") は <図1>の「No」を含まないセル '仮の最小の計算-------- min = 0 For a = 1 To 移動数 min = min + 重みtab(t01(a), t02(a)) ttt(a) = a Next '---------------------- Call 再帰関数(移動数, t03, 1) 'Sheet2に出力---------- For a = 1 To 移動数 Sheets("Sheet2").Cells(a, 1) = t01(a) Sheets("Sheet2").Cells(a, 2) = t02(ttt(a)) Next '---------------------- End Sub Sub 再帰関数(移動数 As Integer, t03() As Integer, cnt1 As Integer) Dim cnt2 As Integer Dim flg As Boolean For a = 1 To 移動数 flg = True For b = 1 To cnt1 - 1 If t03(b) = a Then flg = False End If Next If flg Then t03(cnt1) = a If cnt1 < 移動数 Then cnt2 = cnt1 cnt1 = cnt1 + 1 Call 再帰関数(移動数, t03, cnt1) cnt1 = cnt2 Else Call 処理(移動数, t03) End If t03(cnt1) = 0 End If Next End Sub Sub 処理(移動数 As Integer, t03() As Integer)  ’最小であるか確認 Dim a As Integer Dim b As Integer For a = 1 To 移動数 b = b + 重みtab(t01(a), t02(t03(a))) Next If min > b Then min = b For a = 1 To 移動数 ttt(a) = t03(a) Next End If End Sub

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

  • ベストアンサー
  • ki073
  • ベストアンサー率77% (491/634)
回答No.10

No.9のプログラムを書いておきます。Rubyなので参考になるか分かりませんが一応、 require "narray" # 労力合計を計算 def sum_work(grA, grB, works_na) works_na[NArray.to_na(grA)*(works_na.shape[0])+NArray.to_na(grB)].sum end # 山登り法 def method1(grA, grB, works_na) min=[sum_work(grA, grB, works_na), grB] loop do min2=(0...grA.size).to_a.combination(2).collect{|i, j| # 順番を入れ替える要素i,j b=min[1].dup # B群の値をコピー b[i], b[j]=b[j], b[i] # 入れ替え [sum_work(grA, b, works_na), b] # 労力合計を計算 }.min_by{|c| c[0]} # 最小値を求める break if min2[0]>=min[0] # 小さな値がなければ終了 min=min2 # 最小値を書き換え end [min[0], grA, min[1]] # [sum_work, A, B] end # 初期値3 def method3(grA, grB, works_na) grB_rot=(grB+grB[0..-2]).each_cons(grB.size).to_a # Bのローテイト配列 grB_rot.collect{|b| method1(grA, b, works_na) }.min_by{|c| c[0]} end B群のランダムに並び替えて初期値としたものを追加 最小の労力合計が一定回数(ここでは5回)に達したら答えとする方法です。 アルゴリズムが簡単なので捨てがたいです。 # 初期値をランダムに def method5(grA, grB, works_na) rand_results=[] begin b=grB.sort_by{rand} # B群をランダムな順番に並び替え rand_results<<method1(grA, b, works_na) min=rand_results.min_by{|c| c[0]} end until rand_results.select{|c| c[0]==min[0]}.size>=5 min end

PinCin
質問者

お礼

お礼が遅くなりました。申し訳ありません。 ki073 さんの「山登り法」を使わさせていただきサクサクと処理ができています。 A群、B群がそれぞれ1000件ぐらいでも多少待ちますが、苦にならないほど早く処理がなされます。 初期値は提案していただいたものを比較させていただき、 A群[1:2:3:4:5] B群[1:2:3:4:5]    ↓ A群[1:2:3:4:5] B群[5:1:2:3:4]    ↓ A群[1:2:3:4:5] B群[4:5:1:2:3] と要素を順にずらして一番最小のものを使用しております。 このアルゴリズムを元に、A群、B群の要素数が違う場合の処理も考えて作成しております。 親身に考えてくださってありがとうございました。

その他の回答 (9)

  • ki073
  • ベストアンサー率77% (491/634)
回答No.9

総当たり法はどうしても限界があるので、昨夜「山登り法」を試してみました http://ja.wikipedia.org/wiki/山登り法 アルゴリズム1 1. A群,B群の初期値を与えます(後述) 2. 労力の合計を計算する(労力合計1とする) 3. B群の中の2つの要素を入れ替えた組み合わせを作る(組み合わせが28ある) 4. それぞれについて労力の合計を計算する 5. 労力合計1より小さいものがあれば、一番小さいものに置きかえ、労力合計1を書き換え3にもどる。小さいものが無ければ終了 以上です。 初期値1 A群,B群をそのまま初期値とする 誤差0が962個、誤差2が27、誤差4が3、誤差6が1、誤差10が5、誤差12が1、誤差20が1 原理的にどうしても誤差の大きなものがでる可能性がある 初期値2 No.2の提案1の結果を初期値に 誤差0が985個、誤差2が14、誤差8が1 提案1より改善されています 初期値3 B群を1つずつローテーションした値(8組)を初期値とし、8組全部を計算し最小のものを使用 全部誤差0 初期値4 No.2の提案1の7をやる前の値(8組)を初期値とし、8組全部を計算し最小のものを使用 全部誤差0 山登り法は初期値により局所的な頂上に行ってしまうことが原理的に避けられませんので、初期値3よりも、初期値4の方が安心して使えるように思います。

  • Tacosan
  • ベストアンサー率23% (3656/15482)
回答No.8

机の過不足関係を供給・需要と思い, ある部屋から別の部屋への距離を費用とすれば, そのまま最小費用流だよね.

PinCin
質問者

お礼

お礼が遅くなりました。申し訳ございません。 「最小費用流」納得しました。 しかし、それをプログラムに起こすことができませんでした。 アイディアをありがとうございます。

  • ki073
  • ベストアンサー率77% (491/634)
回答No.7

No.4です。 >100個のデータというのは、A群:100個 B群:100個でしょうか。 8個の数値からなるA群を作って、数値が重ならないように8個の数値からなるB群を作るという方法です。 それを100組分作ってチェックしました。要するに図2を100組です。 さらに1000組まで増やして計算した誤差です。 誤差0が668, 誤差2が261, 誤差4が49, 誤差6が10, 誤差8が6, 誤差10が4, 誤差12が1, 誤差14が1という結果です。 プログラムをざっと見たのですが、 重みtab(t01(a), t02(a)) などように重みtabのなかにt01(a)のように配列がはいっているのをやめて、 最初に重みtabの必要な部分だけを取り出したA群数×B群数の大きさの配列(抜き出した重みtab)をつくってしまったらどうでしょうか。 そうすると「抜き出した重みtab(a,a)」で取り出せますので、多少は速くなりそうな気がします。 それとNo.1でも指摘されていますが、再帰呼び出しは一般的にはかなり遅くなります。普通にぐるぐるループを回した方が速いです。

  • nag0720
  • ベストアンサー率58% (1093/1860)
回答No.6

#3です。 #3の回答に誤りがありました。 1~4を第1グループ(G1) 5~9を第2グループ(G2) 10~13を第3グループ(G3) 14~18を第4グループ(G4) です。(コピー&ペーストしたあと変更し忘れました) >人力でグループ分けをするのは避けたいと思っております。 ><図1>の補足ですが、 >別のシートで、建物の上から見た図を階数ごとに作成できるようになっていて、 >そこから、プログラムで部屋ごとの距離(重み)を<図1>に出力しています。 別シートにどんな情報があって、どのようなプログラムで<図1>を出力しているのか分かりませんが、 その別シートの情報からは自動でグループ分けすることができないんでしょうか? <図1>を見ると、 「1~4は近接していて、5~9は同じ階の少し離れたところに近接していて、10~13、14~18は別の階に1~4、5~9と同じ位置関係にある」 と想像できますが、別シートの情報からそのようなことを判断するのは難しいのでしょうか? もしそうなら、グループ分けは手作業でやるしかないでしょう。 それとも、図面を見てもグループ分けすること自体が難しいのでしょうか? そうであればこの方法は使えません。

PinCin
質問者

お礼

ありがとうございます。 実際に今回のデータは1~9が1階、10~18が2階で、1~9と10~18はそれぞれ上下の関係にあり、1~4と5~9は離れています。階段は、3、5の近くに2か所あります。 しかし、今回のようにキレイにグループ分け出来るような間隔で部屋があるとは限りません。 例えば4と5の部屋のちょうど間に部屋が来るような場合があるかも知れず、その点を考慮すると、グループで分けて考えるのは難しいように感じます。 また、同じ階でも、端から端に移動するより、上下に移動する方がいい場合もあるので、各部屋への移動する労力を数値化して<図1>表を作成する方法をとりました。

  • Tacosan
  • ベストアンサー率23% (3656/15482)
回答No.5

「最小費用流」っぽい.

PinCin
質問者

お礼

回答ありがとうございます。 「最小費用流」を調べましたが、よくわかりませんでした。 もう少し詳しく教えていただけますか?

  • ki073
  • ベストアンサー率77% (491/634)
回答No.4

こういう問題は整数計画法という分野が有って、アルゴリズムもできています。 EXCELにもそのためのソルバーがあります。整数計画法で検索してみてください。ちょっと取っ付きにくいところがあるのですが、利用するのは簡単です。もし興味が有りましたら書き込んでください。 No.2で提案されている提案1ですが、ちょっとやってみました。ランダムに100個のデータを発生させて図1のデータを使っやりました。 総当たり法と、提案1による比較では提案1の正答率は43%で、誤差があった場合の大半は2大きく出ている程度ですので近い値にはなるような感じです。最大の誤差は12のものがありましたので、これをどう見るかですが。 (実際にはEXCELではなくRubyでやっています。この場合は100個で総当たりの実行時間が1秒程度です)

PinCin
質問者

お礼

回答ありがとうございます。 整数計画法を調べましたが、おっしゃる通り難しいですね。 ソルバーは、ソルバーアドインをインストールする必要がありますよね。 インストール等は行いたくありません。 特定のPCで行うわけではなく、また、PCには環境復元ソフトが入っているため、インストールが難しいです。 No.2の提案を試してくださり、ありがとうございます。 誤差は2程度ですか。このくらいなら妥協できる範囲だと思います。 ただ12の誤差が出るのは、気になりますね。 100個のデータというのは、A群:100個 B群:100個でしょうか。

  • nag0720
  • ベストアンサー率58% (1093/1860)
回答No.3

>多少結果は妥協して(最小に近い値)でも処理を早くしたいと思っていますが、 ということなら、 <図1>を見ると、部屋Noがグループ化できることが分かります。 1~4を第1グループ(G1) 5~9を第1グループ(G2) 10~13を第1グループ(G3) 14~18を第1グループ(G4) とすれば、<図2>のA群、B群は、 A群:G2,G2,G2,G3,G4,G4,G4,G4 B群:G1,G1,G1,G2,G2,G3,G3,G3 となります。さらに<図1>から、 G1⇔G1、G2⇔G2、G3⇔G3、G4⇔G4 の移動労力を0 G1⇔G2、G1⇔G3、G2⇔G4、G3⇔G4 の移動労力を1 G1⇔G4、G2⇔G3 の移動労力を2 と簡略化できるので、これでA群からB群への最小移動のグループの組み合わせを求めます。 これなら、すべての組み合わせの総数はかなり少なくなるので時間を短縮できるはずです。 これができたら、それぞれのグループを元の部屋Noに戻して、グループ内での最小移動の組み合わせを求めます。 ただし、A群からB群への最小移動のグループの組み合わせは1つとは限りません。複数あったら、それぞれに対してこの処理をして、最小の移動労力を調べる必要があります。

PinCin
質問者

お礼

回答ありがとうございます。 画像にある<図1>データですが、これは変わる可能性があるので、値が変わると、グループを考え直さなければなりません。 グループ分けを素早くプログラム上でできるでしょうか。 人力でグループ分けをするのは避けたいと思っております。 <図1>の補足ですが、 別のシートで、建物の上から見た図を階数ごとに作成できるようになっていて、 そこから、プログラムで部屋ごとの距離(重み)を<図1>に出力しています。

  • utun01
  • ベストアンサー率40% (110/270)
回答No.2

ソースは書いていませんが、アルゴリズムレベルのご提案です。 提案1:ベターな解を求める 1、A群の要素(1)から最も近いB群の要素Xを探し、これを確定します。 2、A群の要素(2)以降も同様に確定していきます。 3、一通り終わったらこの結果を保存しておきます。 4、最初に戻りA群の要素(2)から最も近いB群の要素Xを探し、これを確定します。 5、A群の要素(1),(3)~を同様に処理します。 6、残りを同様に処理します。 7、A群の要素数分の解が出ているので、この中から最小の値を探す。 提案2:最適解を求める ご提示されたソースは読み込んでおりませんが、「再帰関数」部分をクイックソート的なアルゴリズムに変えることが出来れば改善されるように思います。 その他: 「重みtab」はrangeオブジェクトのまま使用すべきではありません。 別途テーブル用のクラスを作り、そこで管理すべきです。 Excelオブジェクトへのアクセスは非常に重たい処理ですので、これを改善するだけで一気に改善される可能性があります。 また、重い処理をする際にはExcelの描画と計算を止めて下さい。 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_090_040.html

PinCin
質問者

お礼

回答ありがとうございます。 提案1 そのようなアルゴリズムも頭の中では考えていましたが、あまり小さい値が出てこないのではないかと思い、試していませんでした。 今度試して妥協できるような値が出るかを確認してみたいと思います。 提案2 「クイックソート」はわかるのですが、今回のプログラムにどのように活用できるか、見当もつかないのですが、もう少し説明を加えていただけますか。 >「重みtab」はrangeオブジェクトのまま使用すべきではありません。 ループで値だけテーブルに代入するプログラムを作成するということですね。 試してみます。

  • Tacosan
  • ベストアンサー率23% (3656/15482)
回答No.1

図2 の数字の意味が分かりません.

PinCin
質問者

お礼

説明が足りませんでした。 <図2>のA群、B群は部屋番号を表しています。 A群にある一番初めの要素「5」は、「5」の部屋から机を持ち出したい(机がいらない) B群にある一番初めの要素「1」は、「1」の部屋に机を持ってくる(机が必要である) A群の「15」は2つありますが、それは、机が2ついらないことを表しています。 B群も同じで、同じ数字が2つある場合は2つ必要であることを表しています。 ※同じ数字が3つ4つとなる可能性もあります。

関連するQ&A

  • プログラミングVisual Basicの質問です。

    任意の数字を入力し、Len関数とMid関数を使って2進数を10進数に変換するというプログラムを作っているのですが、うまくいきません。 コードは Dim a  As Integer Dim b  As Integer Dim i  As Integer a = Val(TextBox1.Text) For i = Len(a) To 1 Step -1 If Mid(a, Len(a), 1) = "1" Then b += 2 ^ (i - 1) End If Next Label3.Text = b    End Sub 上記のものが作ったコードです。 問題点の指摘をよろしくお願いします。

  • 擬似マインスイーパー

    任意の地雷を設置するというプログラムです。 この中で地雷を*に、安全地帯を空白にしたいのですがやり方がわからないので、わかる方お願いします。 Sub mine() Dim minefield(11, 13) As Integer Dim i As Integer, a As Integer, b As Integer Dim c As Integer c = InputBox("地雷の数を決めます") Randomize For i = 1 To c a = Int(Rnd * 10) + 1 b = Int(Rnd * 12) + 1 If minefield(a, b) = 9 Then i = i - 1 minefield(a, b) = 9 Next i countMine minefield, 10, 12 showInt minefield, 10, 12 ' show minefield, 10, 12 End Sub Sub countMine(f() As Integer, h As Integer, w As Integer) Dim i As Integer, j As Integer Dim a As Integer, b As Integer Dim x As Integer For a = 1 To 10 For b = 1 To 12 If f(a, b) < 9 Then x = 0 If f(a, b - 1) = 9 Then x = x + 1 '左に地雷があるか If f(a, b + 1) = 9 Then x = x + 1 '右に地雷があるか ' ... この部分に追加したいのだが ... f(a, b) = x End If Next b Next a End Sub Sub showInt(f() As Integer, h As Integer, w As Integer) Dim i As Integer Const a As Integer = 7 Const b As Integer = 3 Do While h > 0 For i = 1 To w Cells(a + h, b + i) = f(h, i) Next i h = h - 1 Loop End Sub

  • VBA 選択された離れたセルの値の取得について

    EXCELのVBAでどうしても前に進めず困っております。 目的としているコードは、離れたセル(複数)をあらかじめCtrlキーで選択状態にしておき、選択されたセルの値のみをVBAが別のセルに並べていくというものです。 以下が私の作ったコードなのですが、思ったとおりの動作をしてくれません。 VBA初心者なもので、おかしな記述がたくさんあると思うのですが、どなたかアドバイスお願いします。 Public Sub xx() Dim SelectArea As String Dim TargetCell As Range Dim a As Integer Dim Row As Integer Dim Column As Integer Dim CNT1 As Integer a = 0 Row = 0 Column = 0 For CNT1 = 1 To 10 Row = Row + 1 SelectArea = Selection.Address Set TargetCell = Range("B3").Cells(Row - 1, Column) If Intersect(Range(SelectArea), TargetCell) Is Nothing Then Else Range("A30").Cells(a, 0) = Range("B3").Cells(Row - 1, Column).Value a = a + 1 End If Next End Sub

  • VB2005で、Structureの配列を返すプログラムを以下のように書きたい

    VB2005で、Structureの配列を返すプログラムを以下のように書きたいのですが、そもそもVB6しか使ったことが無いもので、以下のような素数の結果を返すこのプログラムの書き方はVB2005らしいでしょうか? Module Module1 Public Structure SosuuStatus Public num As Integer Public status As String End Structure Class Sosuu Function SosuuCheck(ByVal st As Integer, ByVal ed As Integer) As SosuuStatus() Dim i As Integer, j As Integer Dim sosuu(0 To ed - st) As SosuuStatus Dim cnt As Integer = 0 For i = st To ed sosuu(cnt).num = i sosuu(cnt).status = "" '初期化 If 1 = i Then sosuu(cnt).status = "素数ではない" ElseIf 0 = (i Mod 2) Then sosuu(cnt).status = "素数ではない" Else For j = 3 To Math.Sqrt(ed) If 0 = (i / j) Then sosuu(cnt).status = "素数ではない" End If Next j End If If sosuu(cnt).status = "" Then sosuu(cnt).status = "素数である" End If cnt = cnt + 1 Next i SosuuCheck = sosuu End Function End Class End Module

  • ユーザーフォームがエラーになってしまって困っています。

    VBA初心者なので、テキスト本を参考にユーザーフォームを作ったのですが、エラーになってしまって困っています。 フォーム上のコンボボックス、テキストボックスに入力した値をワークシート上に転記したいのですがエラーが出てしまって先に進めずに困っています。 どなたかお力をお貸し頂けませんでしょうか? Option Explicit Dim TBL(1 To 8) As Control Dim データ範囲 As Range ---------------------------- Private Sub UserForm_Initialize() With Combo会社名 .MatchEntry = fmMatchEntryFirstLetter .ColumnCount = 2 .TextColumn = 1 End With With Combo住所1 .AddItem "東京都" .AddItem "埼玉県" .AddItem "神奈川県" End With Set TBL(1) = Textコード番号 Set TBL(2) = Text登録年月日 Set TBL(3) = Combo住所1 Set TBL(4) = Combo会社名 Set TBL(5) = Text郵便番号 Set TBL(6) =Text住所2 Set TBL(7) = Text 住所3 Set TBL(8) = Text電話番号 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = レコード数取得 + 1 If データ範囲.Rows.Count = 1 Then Else データ表示 2 End If End Sub ---------------------------------------- Public Function レコード数取得() As Integer レコード数取得 = Range("A1").CurrentRegion.Rows.Count - 1 End Function ---------------------------------------- Public Sub データ表示(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 19 TBL(Cnt).Value = データ範囲.Cells(行数, Cnt).Value  ---この部分でエラー Next Textレコード.Value = Spin移動.Value - 1 & "/" & レコード数取得 End Sub ------------------------------------- Private Sub Spin移動_Change() If データ範囲.Rows.Count <> 1 Then データ表示 (Spin移動.Value) End If End Sub ------------------------------------ Private Sub Button追加_Click() Dim AddRow As Integer AddRow = データ範囲.Rows.Count + 1 データ書き込み (AddRow) Textレコード.Text = Spin移動.Value - 1 & "/" & レコード数取得 Set データ範囲 = Range("A1").CurrentRegion Spin移動.Max = データ範囲.Rows.Count Spin移動.Value = データ範囲.Rows.Count データ表示 (AddRow) End Sub ------------------------------------- Private Sub Button更新_Click() データ書き込み (Spin移動.Value) End Sub ------------------------------------- Public Sub データ書き込み(行数 As Integer) Dim Cnt As Integer For Cnt = 1 To 19 データ範囲.celles(行数, Cnt).Value = TBL(Cnt).Value Next End Sub -------------------------------------- Private Sub Button終了_Click() ActiveWorkbook.Save Application.DisplayAlerts = False Unload Me ActiveWorkbook.Close Application.Quit End Sub

  • VBAのプロシージャーと変数の名前の区別について

    VBAの初心者です。教えてください。 Sub ex() Dim a As Integer Dim b As Integer a = 2 a a, b MsgBox b End Sub Sub a(a As Integer, b As Integer) b = a End Sub 上記のプログラムを実行するとうまくいきません。VBAのプロシージャーと変数って同じ名前を使うとだめなのですか?教えてください。

  • エクセル VBA OptionButtonからTextBox

    すいません! OptionButtonなら 下記の記述でエラー表示を 簡単にできるのですが これがOptionButtonではなく TextBoxならどのように変化したら 良いのでしょうか? すいません、教えて下さい! Private Sub 記録_Click() Dim i As Integer Dim Cnt As Integer Cnt = 0 For i = 1 To 6 Step 1 If Me.Controls("OptionButton" & i).Value Then Cnt = i Exit For End If Next i If Cnt = 0 Then MsgBox "選択されていません" Exit Sub End If If Me.Controls("Combobox" & Cnt).Value = "" Then MsgBox Me.Controls("OptionButton" & Cnt).Caption & " の内容が選択されていません" Exit Sub End If With 記入フォーム .TextBox5.Value = Me.Controls("OptionButton" & Cnt).Caption .TextBox6.Value = Me.Controls("Combobox" & Cnt).Value End With Unload Me End Sub

  • マインスイーパーもどき(VBA)

    ExcelのVBAでマインスイーパーもどきを作っていますが、どうも上手くいきません。9が地雷で0が何もないと言うことです。以下、ソースです。 Sub mine() Dim minefield(11, 13) As Integer Dim i As Integer, a As Integer, b As Integer, x As Integer x = 0 Randomize For i = 1 To 20 a = Int(Rnd * 10) + 1 b = Int(Rnd * 12) + 1 If minefield(a, b) = 9 Then x = x + 1 i = i - 1 End If minefield(a, b) = 9 Next i MsgBox "地雷が" & x & "回重複" countMine minefield, 10, 12 showInt minefield, 10, 12 show minefield, 10, 12 End Sub Sub show(f() As Integer, h As Integer, w As Integer)  Dim a As Integer, b As Integer For a = 1 To 10 For b = 1 To 12 If (f(a, b) = 9) Then CStr(f(a, b)) = "*" If (f(a, b) = 0) Then CStr(f(a, b)) = " " Next b Next a End Sub If (f(a, b) = 9) Then CStr(f(a, b)) = "*" If (f(a, b) = 0) Then CStr(f(a, b)) = " " の部分でコンパイル時に 「コンパイルエラー:修正候補 識別子」 とでます。ヘルプを見てもよくわかりませんでした。 テキストが長すぎるので途中は省きました。 よろしくお願いします。

  • エクセルVBAの次のコードの意味教えて下さい。

    Sub macro1() Dim a As Integer, b As Integer a = 1 b = 5 macro2 a, b MsgBox a + b End Sub Sub macro2(c As Integer, d As Integer) c = c * 10 d = d * 5 End Sub 答えは35と出ます。 よろしくお願いします。

  • macroについて教えてください

    こんにちは。以前こちらでPrivate SubについてMacroを教えていただきました。(あの後ログインパスワード等が不明になりお礼も出来ませんでしたが。。。回答頂いた方すみませんでした。) 下記がそのMacroですが、今回また少し変えることになり どのように変えていいのか分かりません。 前回は1~5はグレー、6~10は茶色・・・という形にしたのですが 今回は進捗率での管理をしたく、80%以下は白、80~90%は赤、90~100%は青としたいと思っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim iColors As Variant Dim rw As Long Dim CellCnt As Integer Dim col As Integer Dim col2 As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim c As Variant Dim ar() As Variant Dim Sh1 As Worksheet Set Sh1 = Worksheets("小児科Dr") col = Target.Cells(1).Column '制限された列 If Not (col = 4 Or col = 8 Or col = 12 Or col = 16) Then Exit Sub iColors = Array(16, 16, 16, 16, 16, 53, 53, 53, 53, 53, 54, 54, 54, 54, 54) CellCnt = Target.Count ReDim ar(CellCnt - 1) For Each c In Target If c.Value <> "" Then If IsNumeric(c.Value) Then i = c.Value If i >= 11 Then i = 10 End If If i > 0 And i < 11 Then j = iColors(i - 1) Else j = 2 End If ar(k) = j k = k + 1 End If End If Next c rw = Target.Row Select Case col Case 4: col2 = 2 Case 8: col2 = 8 Case 12: col2 = 14 Case 16: col2 = 20 'Sh1.Cells(rw + 2, 13).Resize(Int(Target.Count / 3), 3).Interior.ColorIndex = j End Select InsideColors Sh1, rw, col2, CellCnt, ar() Set Sh1 = Nothing End Sub Private Sub InsideColors(sh As Worksheet, _ rw As Long, _ col As Integer, _ cnt As Integer, _ ar As Variant) 'sh[シート],rw[行], col[列],cnt[セル個数],iColor[色指数] Dim i As Integer Dim j As Integer Dim n As Integer Dim k As Integer If cnt Mod 5 > 0 Then '範囲行数 i = (cnt + 5 - (cnt Mod 5)) / 5 Else i = cnt / 5 End If rw = Int((rw - 1) / 5) + 1 '行再設定 j = ((rw - 1) Mod 5) + 1 '列設定 For n = j To cnt sh.Cells(rw + 2, col).Resize(i, 5).Cells(n).Interior.ColorIndex = ar(k) k = k + 1 Next n End Sub 毎回他の人を頼ってしまい、申し訳ないのですがお願いします。 また、前回分からなかったので1~5を指定するときに5回同じカラー番号を書いたのですがこちらも良かったら手直し方法を教えていただければ助かります。 宜しくお願いします。