人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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




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

●質問者: ReoReo7
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:エクセル コメント バリエーション プログラム ポイント
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● きゃづみぃ
●100ポイント ベストアンサー
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 ● きゃづみぃ
●100ポイント
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. で 一致する場合 (). に置換するようにしてみました。


3 ● きゃづみぃ
●100ポイント

【プログラム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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ