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





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

回答の条件
  • 1人3回まで
  • 登録:2007/02/26 21:19:39
  • 終了:2007/03/04 14:01:54

ベストアンサー

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982007/02/27 07:34:30

ポイント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ベストアンサー獲得回数11982007/02/27 07:34:30ここでベストアンサー

ポイント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ベストアンサー獲得回数11982007/02/27 22:42:12

ポイント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ベストアンサー獲得回数11982007/02/26 22:54:19

ポイント100pt

【プログラム1】

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

G1とA1で置換します。

.

【プログラム2】

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

  • id:ReoReo7
    仕様:
    【プログラム1】
    1)G列に英文が書いてある。例えば
    This is a pen.

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

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


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

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


    2)ある行(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列には1~3のいずれかの数字がそれぞれ入ります。

    3)次に100行は自動で削除されます。

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


    【プログラム2の実行例】
    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
    追記:

    上のあと、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
    This is a pen.

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

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

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

    今日は ちょっと これ以降できませんので。
  • id:taknt
    修正して 回答しましたので 2回目のほうだけ 開いてもらっていいです。
  • id:ReoReo7
    拝見しました。ありがとうございます。今夜にでも使ってみます。
  • id:taknt
    プログラム1のほうですが、対象となる行は プログラム2と関連させたほうが よかったでしょうか?

    Macro2のほうが プログラム1ですが、セルがG1とA1のみで作ってあります。
  • id:ReoReo7
    プログラム2の動作を確認しました。所望の動作です。ありがとうございます。感謝します。

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

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません