id:ReoReo7
ポイントあり300ptベストアンサーあり
コンピュータウェブ制作

お気持ちのみですが合計で300ポイント～差し上げます。エクセルのマクロを２つ作ってください。作りたいものは英語の選択式問題集【プログラム１】です。さらに、問題のバリエーションを増やしたいと思います【プログラム２】。コメントに仕様を示します。





以上よろしくおねがいします。質問ありましたらコメントからお願いします。

回答の条件
  • 1人3回まで
  • 登録：
  • 終了：2007/03/04 14:01:54
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:taknt No.1

回答回数13539ベストアンサー獲得回数1198

ポイント100pt 
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
    A = Selection.Row
    
    
start:
    If Range("H" & A) = "" Then End
    a1 = A + 1
    Rows((A + 1) & ":" & (A + 3)).Select
    Selection.Insert Shift:=xlDown
    
    '三行分作成
    For e = 1 To 3
        'A～G列、M列、N列の複写
        Range("A" & a1) = Range("A" & A)
        Range("B" & a1) = Range("B" & A)
        Range("C" & a1) = Range("C" & A)
        Range("D" & a1) = Range("D" & A)
        Range("E" & a1) = Range("E" & A)
        Range("F" & a1) = Range("F" & A)
        Range("G" & a1) = Range("G" & A)
        Range("M" & a1) = Range("M" & A)
        Range("N" & a1) = Range("N" & A)
        
        '最初にもってくる選択肢を決める
        Randomize
        c = Int(9 * Rnd)
        d = 2
        If c <= 3 Then d = 1
        If c >= 6 Then d = 3
        c = Int(9 * Rnd)
        d1 = 2
        If c <= 3 Then d1 = 1
        If c >= 6 Then d1 = 3
        c = Int(10 * Rnd)
        d2 = 2
        If c <= 5 Then d2 = 1
        
        '答えをセット
        Range("L" & a1) = d
        
        Select Case d
            Case 1
                Range("H" & a1) = Range("H" & A)
                Select Case d1
                    Case 1
                        Range("I" & a1) = Range("I" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("J" & A)
                        End Select
                    Case 2
                        Range("I" & a1) = Range("J" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                    Case 3
                        Range("I" & a1) = Range("K" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("J" & A)
                            Case 2: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                End Select
            Case 2
                Range("I" & a1) = Range("H" & A)
                Select Case d1
                    Case 1
                        Range("H" & a1) = Range("I" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("J" & A)
                        End Select
                    Case 2
                        Range("H" & a1) = Range("J" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                    Case 3
                        Range("H" & a1) = Range("K" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("J" & A)
                            Case 2: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                End Select
            Case 3
                Range("J" & a1) = Range("H" & A)
                Select Case d1
                    Case 1
                        Range("H" & a1) = Range("I" & A)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("J" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("I" & a1) = Range("K" & A): Range("K" & a1) = Range("J" & A)
                        End Select
                    Case 2
                        Range("H" & a1) = Range("J" & A)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("I" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("I" & a1) = Range("K" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                    Case 3
                        Range("H" & a1) = Range("K" & A)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("I" & A): Range("K" & a1) = Range("J" & A)
                            Case 2: Range("I" & a1) = Range("J" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                End Select
            End Select
        a1 = a1 + 1
    Next e
    
    Rows(A & ":" & A).Select
    Selection.Delete Shift:=xlUp
    A = a1 - 1
    GoTo start
End Sub

Sub Macro2()
    Range("G1") = Replace(Range("G1"), " " & Range("A1") & " ", " () ")
    
    If Range("A1") & " " = Left(Range("G1"), Len(Range("A1") & " ")) Then
        Range("G1") = "() " & Right(Range("G1"), Len(Range("G1")) - Len(Range("A1") & " "))
    End If
    
    If " " & Range("A1") = Right(Range("G1"), Len(" " & Range("A1"))) Then
        Range("G1") = Left(Range("G1"), Len(Range("G1")) - Len(" " & Range("A1"))) & " ()"
    End If
End Sub

その他の回答（2件）

id:taknt No.1

回答回数13539ベストアンサー獲得回数1198ここでベストアンサー

ポイント100pt 
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
    A = Selection.Row
    
    
start:
    If Range("H" & A) = "" Then End
    a1 = A + 1
    Rows((A + 1) & ":" & (A + 3)).Select
    Selection.Insert Shift:=xlDown
    
    '三行分作成
    For e = 1 To 3
        'A～G列、M列、N列の複写
        Range("A" & a1) = Range("A" & A)
        Range("B" & a1) = Range("B" & A)
        Range("C" & a1) = Range("C" & A)
        Range("D" & a1) = Range("D" & A)
        Range("E" & a1) = Range("E" & A)
        Range("F" & a1) = Range("F" & A)
        Range("G" & a1) = Range("G" & A)
        Range("M" & a1) = Range("M" & A)
        Range("N" & a1) = Range("N" & A)
        
        '最初にもってくる選択肢を決める
        Randomize
        c = Int(9 * Rnd)
        d = 2
        If c <= 3 Then d = 1
        If c >= 6 Then d = 3
        c = Int(9 * Rnd)
        d1 = 2
        If c <= 3 Then d1 = 1
        If c >= 6 Then d1 = 3
        c = Int(10 * Rnd)
        d2 = 2
        If c <= 5 Then d2 = 1
        
        '答えをセット
        Range("L" & a1) = d
        
        Select Case d
            Case 1
                Range("H" & a1) = Range("H" & A)
                Select Case d1
                    Case 1
                        Range("I" & a1) = Range("I" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("J" & A)
                        End Select
                    Case 2
                        Range("I" & a1) = Range("J" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                    Case 3
                        Range("I" & a1) = Range("K" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("J" & A)
                            Case 2: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                End Select
            Case 2
                Range("I" & a1) = Range("H" & A)
                Select Case d1
                    Case 1
                        Range("H" & a1) = Range("I" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("J" & A)
                        End Select
                    Case 2
                        Range("H" & a1) = Range("J" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("J" & a1) = Range("K" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                    Case 3
                        Range("H" & a1) = Range("K" & A)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & A): Range("K" & a1) = Range("J" & A)
                            Case 2: Range("J" & a1) = Range("J" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                End Select
            Case 3
                Range("J" & a1) = Range("H" & A)
                Select Case d1
                    Case 1
                        Range("H" & a1) = Range("I" & A)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("J" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("I" & a1) = Range("K" & A): Range("K" & a1) = Range("J" & A)
                        End Select
                    Case 2
                        Range("H" & a1) = Range("J" & A)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("I" & A): Range("K" & a1) = Range("K" & A)
                            Case 2: Range("I" & a1) = Range("K" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                    Case 3
                        Range("H" & a1) = Range("K" & A)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("I" & A): Range("K" & a1) = Range("J" & A)
                            Case 2: Range("I" & a1) = Range("J" & A): Range("K" & a1) = Range("I" & A)
                        End Select
                End Select
            End Select
        a1 = a1 + 1
    Next e
    
    Rows(A & ":" & A).Select
    Selection.Delete Shift:=xlUp
    A = a1 - 1
    GoTo start
End Sub

Sub Macro2()
    Range("G1") = Replace(Range("G1"), " " & Range("A1") & " ", " () ")
    
    If Range("A1") & " " = Left(Range("G1"), Len(Range("A1") & " ")) Then
        Range("G1") = "() " & Right(Range("G1"), Len(Range("G1")) - Len(Range("A1") & " "))
    End If
    
    If " " & Range("A1") = Right(Range("G1"), Len(" " & Range("A1"))) Then
        Range("G1") = Left(Range("G1"), Len(Range("G1")) - Len(" " & Range("A1"))) & " ()"
    End If
End Sub
id:taknt No.2

回答回数13539ベストアンサー獲得回数1198

ポイント100pt 
Sub Macro2()
    For a = 1 To 65536
        If Range("G" & a) = "" Then Exit For
        Range("G" & a) = Replace(Range("G" & a), " " & Range("A" & a) & " ", " () ")
        
        If Range("A" & a) & " " = Left(Range("G" & a), Len(Range("A" & a) & " ")) Then
            Range("G" & a) = "() " & Right(Range("G" & a), Len(Range("G" & a)) - Len(Range("A" & a) & " "))
        End If
        
        If " " & Range("A" & a) & "." = Right(Range("G" & a), Len(" " & Range("A" & a) & ".")) Then
            Range("G" & a) = Left(Range("G" & a), Len(Range("G" & a)) - Len(" " & Range("A" & a) & ".")) & " ()."
        End If
    Next a
End Sub

文末の場合は pen. で 一致する場合 (). に置換するようにしてみました。

id:taknt No.3

回答回数13539ベストアンサー獲得回数1198

ポイント100pt

【プログラム１】

Sub Macro2()
    Range("G1") = Replace(Range("G1"), Range("A1"), "()")
End Sub

G1とA1で置換します。

.

【プログラム２】

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
    a = Selection.Row
    
    
start:
    If Range("H" & a) = "" Then End
    a1 = a + 1
    Rows((a + 1) & ":" & (a + 3)).Select
    Selection.Insert Shift:=xlDown
    
    '三行分作成
    For e = 1 To 3
        '最初にもってくる選択肢を決める
    
        Randomize
        c = Int(9 * Rnd)
        d = 2
        If c <= 3 Then d = 1
        If c >= 6 Then d = 3
        c = Int(9 * Rnd)
        d1 = 2
        If c <= 3 Then d1 = 1
        If c >= 6 Then d1 = 3
        c = Int(10 * Rnd)
        d2 = 2
        If c <= 5 Then d2 = 1
        
        '答えをセット
        Range("L" & a1) = d
        
        Select Case d
            Case 1
                Range("H" & a1) = Range("H" & a)
                Select Case d1
                    Case 1
                        Range("I" & a1) = Range("I" & a)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("J" & a): Range("K" & a1) = Range("K" & a)
                            Case 2: Range("J" & a1) = Range("K" & a): Range("K" & a1) = Range("J" & a)
                        End Select
                    Case 2
                        Range("I" & a1) = Range("J" & a)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & a): Range("K" & a1) = Range("K" & a)
                            Case 2: Range("J" & a1) = Range("K" & a): Range("K" & a1) = Range("I" & a)
                        End Select
                    Case 3
                        Range("I" & a1) = Range("K" & a)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & a): Range("K" & a1) = Range("J" & a)
                            Case 2: Range("J" & a1) = Range("J" & a): Range("K" & a1) = Range("I" & a)
                        End Select
                End Select
            Case 2
                Range("I" & a1) = Range("H" & a)
                Select Case d1
                    Case 1
                        Range("H" & a1) = Range("I" & a)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("J" & a): Range("K" & a1) = Range("K" & a)
                            Case 2: Range("J" & a1) = Range("K" & a): Range("K" & a1) = Range("J" & a)
                        End Select
                    Case 2
                        Range("H" & a1) = Range("J" & a)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & a): Range("K" & a1) = Range("K" & a)
                            Case 2: Range("J" & a1) = Range("K" & a): Range("K" & a1) = Range("I" & a)
                        End Select
                    Case 3
                        Range("H" & a1) = Range("K" & a)
                        Select Case d2
                            Case 1: Range("J" & a1) = Range("I" & a): Range("K" & a1) = Range("J" & a)
                            Case 2: Range("J" & a1) = Range("J" & a): Range("K" & a1) = Range("I" & a)
                        End Select
                End Select
            Case 3
                Range("J" & a1) = Range("H" & a)
                Select Case d1
                    Case 1
                        Range("H" & a1) = Range("I" & a)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("J" & a): Range("K" & a1) = Range("K" & a)
                            Case 2: Range("I" & a1) = Range("K" & a): Range("K" & a1) = Range("J" & a)
                        End Select
                    Case 2
                        Range("H" & a1) = Range("J" & a)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("I" & a): Range("K" & a1) = Range("K" & a)
                            Case 2: Range("I" & a1) = Range("K" & a): Range("K" & a1) = Range("I" & a)
                        End Select
                    Case 3
                        Range("H" & a1) = Range("K" & a)
                        Select Case d2
                            Case 1: Range("I" & a1) = Range("I" & a): Range("K" & a1) = Range("J" & a)
                            Case 2: Range("I" & a1) = Range("J" & a): Range("K" & a1) = Range("I" & a)
                        End Select
                End Select
            End Select
        a1 = a1 + 1
    Next e
    
    Rows(a & ":" & a).Select
    Selection.Delete Shift:=xlUp
    a = a1-1
    GoTo start
End Sub

コメント（8件)

  • id:ReoReo7
    ReoReo7 2007/02/26 21:20:04
    仕様：
    【プログラム１】
    １）G列に英文が書いてある。例えば
    This is a pen.

    ２）A列に英単語が書いてある。例えば
    is

    ３）マクロを実行後、G列が
    This () a pen.
    に置換される。


    【プログラム２】
    １）A～N列には英語や数字が書いてある。特に,G列には()で穴抜きされた英文が,H,I,J,K列には選択肢として英単語が,更にL列には答えの番号が書いてあります。

    ここでH列は1番,I列は2番,・・・,K列は4番に対応し、例えばG列の()に入る英単語の答えがI列ならばL列には2と書いてあります。今は答えは必ずH列に書いてありますので,L列には必ず1と書いてあります。


    ２）ある行（100行とする）においてマクロを実行すると、その行の下に新しく3行（101行,102行,103行）が挿入され、101,102,103行のそれぞれの列について次の動作が行われる。

    A～G列、M列、N列：100行と同じものがコピーされる。
    H,I,J,K列に選択肢としての英単語が書いてあり、H列が答えです。L列には正解の番号としてH列に対応する番号つまり1が書いてありますが、101～103行においては、H,I,J,K列の選択肢がランダムで重複なく入れ替わり、L列の番号も答えの場所に連動して変化します。

    ただし,答えの選択肢は必ずH～J列のいずれかに来ます。つまり100行L列には1が、101～103行L列には１～３のいずれかの数字がそれぞれ入ります。

    ３）次に100行は自動で削除されます。

    ※最後の処理として、マクロではなく手動でK列を削除しますので、これで3択の英語の問題が完成します。


    【プログラム２の実行例】
    H～L列のみについて実行例を示します。

    *****：H列,I列,J列,K列,L列
    100行：is,was,that,be,1
    101行：was,be,is,that,3
    102行：is,be,was,that,1
    103行：be,is,that,was,2
  • id:ReoReo7
    ReoReo7 2007/02/26 21:25:12
    追記：

    上のあと、100行が削除されて

    100行：was,be,is,that,3
    101行：is,be,was,that,1
    102行：be,is,that,was,2

    が望むマクロの実行結果になります。

    さらに、K列は手動で削除されますので最終的には
    100行：was,be,is,3
    101行：is,be,was,1
    102行：be,is,that,2
    を仕様します。


    また、実行範囲は選択した行から下とし、実行終了条件は空白セルを発見したらでお願いします。ややこしいですがよろしくお願いします。
  • id:taknt
    きゃづみぃ 2007/02/26 23:00:20
    This is a pen.

    で isで 置換ですが
    「 is 」で 「 () 」に置換としないと ダメですね。

    また is が 文の最初や 最後に ある場合も 置換できないです。

    置換については 後日 考えます。

    今日は ちょっと これ以降できませんので。
  • id:taknt
    きゃづみぃ 2007/02/27 07:35:18
    修正して 回答しましたので 2回目のほうだけ 開いてもらっていいです。
  • id:ReoReo7
    ReoReo7 2007/02/27 12:08:31
    拝見しました。ありがとうございます。今夜にでも使ってみます。
  • id:taknt
    きゃづみぃ 2007/02/27 12:14:12
    プログラム１のほうですが、対象となる行は プログラム２と関連させたほうが よかったでしょうか？

    Macro2のほうが プログラム１ですが、セルがG1とA1のみで作ってあります。
  • id:ReoReo7
    ReoReo7 2007/02/27 19:22:40
    プログラム２の動作を確認しました。所望の動作です。ありがとうございます。感謝します。

    プログラム１ですが、プログラム２のように、空白セルを見つけるまで下に連続実行していくプログラムでお願いします。
  • id:ReoReo7
    ReoReo7 2007/03/04 13:59:40
    完全に望みの動作が得られました。
    感謝します。

この質問への反応（ブックマークコメント）

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません
ユーザー登録をして使いはじめる!無料
すでに登録されている方はこちらからログイン
この質問に含まれるキーワード
知りたいことを検索してみよう
▲ページトップへ