ＶＢＡで問題作成

質問

エクセル2003ＶＢＡと関数を使い問題作成をしようとしています。あらかじめ問題は数十問登録をしておき、ランダムで抽出しようとしています。ここまではできたのですが、次のことがわからないので質問させて頂きます。
例えば
・信号の色は黄色と（　　）と（　　）である。

上記の（　）の中にア若しくは(1)を入れたいのですが、ランダムで問題がでてくるのであらかじめ(1)やアをいれておくと、２問目にでてきたときに(1)やアが表示されたり、１問目に３やウが表示されるので困っています。（回答用紙は別にあるので、問題用紙には答えを書くことはありません）
ちなみに、上記の問題はひとつのセルに問題が書かれております。
解決方法はあるのでしょうか？
よろしくお願いします。

回答No.4

Wendy02 · ベストアンサー

こんばんは。

#3 の回答者です。必ず、#2さんのマクロも試してくださいね。逆の立場になったときのことを、私は、痛いほど知っていますから。また、私は、#2さんのマクロと違いを意識して書かせていただきました。

>構文の意味・説明
というよりも、VBEditor 上で、「ブレークポイント」を設けて、そこで、「ローカルウィンドウ」から、その中の変数に何が格納されているか調べたほうが分かりやすいです。そうやって、マクロを覚えていきます。

今回のポイントは、

>・信号の色は黄色と（　　）と（　　）である。

この「（　　）」をどれだけ正確なものであるのか、ということで、私は、別の方法を選びました。

以下を「正規表現パターン」といいます。

strPattern = "([\(（][^\(（]*[\)）])" '全角半角どちらでも可

半角括弧・全角括弧と半角括弧閉じる・全角括弧閉じる

私のコードの最も大事なところは、この部分です。他の部分は、一種の定石のようなものですから、代わり映えしません。説明するよりも、このコードはある程度決められたものなので、それをそっくり使っているだけです。

これさえ、分かれば、後は、どうにでもなるのです。片方を全角に、閉じる側を半角に入れたらどうするか、というような想定をしています。(　）の中が何もないかもしれないし、空白値が2つ、3つまたは、1つかもしれないと考えた正規表現パターンです。

'リスト配列作成
　Ar = Split(MYLIST, ",")
ここで、リストを一つずつ使うために、配列に組み替えする。

With CreateObject("VBScript.RegExp")
正規表現オブジェクトを使って、「（　　）」をヒットさせています。
　.IgnoreCase = True　'これは、あまり意味がありません。
　.Global = True　'繰り返して探すという意味です。

　　　　For Each c In Range(MYCOL & "1", Range(MYCOL & "65536").End(xlUp))
　　　　　　''正規表現にマッチしているか、テスト？
　　　　　　If .Test(c.Value) Then
　　　　　　　'マッチしているなら、一旦、処理用の変数の中にセルの文字列を入れる
　　　　　　　 buf = c.Value
　　　　　　　 'パターンにマッチしたものを変数に代入
　　　　　　　 Set Matches = .Execute(buf)
　　　　　　　 '一個ずつ取り出し
　　　　　　　 For Each Match In Matches
　　　　　　　　'マッチした文字に対して、Replaceで入れ替える
　　　　　　　　 buf = Replace(buf, Match.Value, "（" & Ar(i) & "）", , 1)
　　　　　　　　 i = i + 1
　　　　　　　 Next Match
　　　　　　　 'セルに代入
　　　　　　　 c.Value = buf
　　　　　　End If
　　　　Next c

後は、個別に、どこが分からないかおっしゃってください。

お礼

詳細な回答頂きありがとうございます。
お返事が遅くなりすみません。
大変参考になりました。
またお世話になるかもしれませんが、その際はよろしくおねがいします。

回答No.3

Wendy02

こんばんは。

以下は、A列を対象としていますから、もし違うようであれば、対象列を書き換えてください。

>・信号の色は黄色と（　　）と（　　）である。
の括弧は、全角でも半角でも、片方が全角で、片方が半角でも、中に空白が入っていても、入っていなくても、どちらでもよいです。ただし、括弧は、全部、全角括弧+括弧閉じるに変えられます。

並びのリストは、現在は、ア～ヨまで、44個しかありません。何を入れても構いませんが、途中で足りなくなるとエラーが出ます。

'標準モジュールが良いです。

'並びのリストは、コンマ切りで入れてください。
Private Const MYLIST As String = "ア,イ,ウ,エ,オ,カ,キ,ク,ケ,コ,サ,シ,ス,セ,ソ,タ,チ,ツ,テ,ト,ナ,ニ,ヌ,ネ,ノ,ハ,ヒ,フ,ヘ,ホ,マ,ミ,ム,メ,モ,ラ,リ,ル,レ,ロ,ワ,ヤ,ユ,ヨ"
Sub RegExpUsedMacro()
　　Dim c As Variant
　　Dim Ar As Variant
　　Dim Matches As Object
　　Dim Match As Object
　　Dim buf As String
　　Dim i As Long
　　Dim strPattern As String

　　'対象列 以下はA列
　　Const MYCOL As String = "A"

　　'リスト配列作成
　　Ar = Split(MYLIST, ",")
　　'パターン
　　strPattern = "([\(（][^\(（]*[\)）])" '全角半角どちらでも可

　　With CreateObject("VBScript.RegExp")
　　　　.Pattern = strPattern
　　　　.IgnoreCase = True
　　　　.Global = True
　　　　Application.ScreenUpdating = False
　　　　For Each c In Range(MYCOL & "1", Range(MYCOL & "65536").End(xlUp))
　　　　　　If .Test(c.Value) Then
　　　　　　　 buf = c.Value
　　　　　　　 Set Matches = .Execute(buf)
　　　　　　　 For Each Match In Matches
　　　　　　　　 '全角括弧
　　　　　　　　 buf = Replace(buf, Match.Value, "（" & Ar(i) & "）", , 1)
　　　　　　　　 i = i + 1
　　　　　　　 Next Match
　　　　　　　 c.Value = buf
　　　　　　End If
　　　　Next c
　　　　Application.ScreenUpdating = True
　　End With
End Sub

お礼

回答ありがとうございます。
回答者様の構文をコピーして貼りつけたら無事に解決しました。
大変感謝しております。
お手数ですが、もしよろしければ後学のため、構文の意味・説明など頂ければ幸いです。
よろしくお願いします。

回答No.2

dokinhime

シート上に問題がいくつか記載されていると思ってよいのでしょうか？

問題がすべて表示された後で、問題が記載されているセルを範囲選択し、次のマクロを実行すると、数字の番号が上から順にふられます。

以下のマクロを標準モジュールに貼り付けてください。

Sub 番号()
Dim QRange As Range
Dim MyRange As Range
Dim QNum As Integer
Dim SerchStart As Long
Dim Ret As Variant
Dim TargetString
Dim MyLen As Byte
Dim LeftStr As String
Dim RightStr As String

TargetString = "（　　）" '置換する文字を指定します。
MyLen = Len(TargetString)

QNum = 1

Set QRange = Selection

For Each MyRange In QRange
SerchStart = 1
Ret = InStr(SerchStart, MyRange, TargetString)
Do While Ret > 0
LeftStr = Replace(Left(MyRange, Ret + MyLen - 1), TargetString, "(　(" & QNum & ")　)")

RightStr = Right(MyRange, Len(MyRange) - Ret - MyLen + 1)

Debug.Print MyRange
Debug.Print LeftStr & RightStr
MyRange = LeftStr & RightStr
QNum = QNum + 1
SerchStart = Ret + 1
Ret = InStr(SerchStart, MyRange, TargetString)
Loop

Next

End Sub

ご質問の意図が違ってたらスイマセン

お礼

回答ありがとうございます。
申し訳ありませんが、今回は先に私の目に入った他の回答者様の回答方法で解決させて頂きました。
ご丁寧に構文まで書いて頂き感謝しております。
仕事が落ち着けば、一度試したいと思っています。
もしよろしければ、回答者様の構文の説明などを頂ければ後学に活かしたいと思っています。
よろしくお願いします。

回答No.1

mshr1962

1問に複数の解答があるのなら
TOI(1)="信号の色は黄色と（@@）と（@@）である。"
TOI(2)="三角形の面積は（@@）×（@@）÷２である。"
のようにセルに置く前に変数に格納して
For～Next文とDo～Loop文で"@@"がなくなるまで
Instr関数で検索してReplace関数で置換すれば良いのでは？

お礼

回答ありがとうございます。
私の不勉強のため、回答者様の回答を応用すること思いつきませんでした。
さらに勉強に励みます。