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

お気持ちのみですが200p?差し上げます。エクセルのマクロについて質問です。

他の質問でで作って頂いたプログラム(最終的に作成されたプログラムコメントに示します)をコメントに示すように少し改変してください。

よろしくお願いします。

●質問者: ReoReo7
●カテゴリ:インターネット ウェブ制作
✍キーワード:エクセル コメント プログラム マクロ 作成
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● きゃづみぃ
●200ポイント ベストアンサー
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
 
 ab = Format(Time, "ss")
 For e1 = 0 To ab
 Randomize
 Next e1
 
 '三行分作成
 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)
 
 f = 0
 
 While f = 0
 '最初にもってくる選択肢を決める
 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
 
 f = 1
 For e1 = 2 To e
 If Range("H" & a1) = Range("H" & a + e1 - 1) And Range("I" & a1) = Range("I" & a + e1 - 1) And Range("J" & a1) = Range("J" & a + e1 - 1) Then f = 0: Exit For
 Next e1
 
 Wend
 a1 = a1 + 1
 Next e
 
 Rows(a & ":" & a).Select
 Selection.Delete Shift:=xlUp
 a = a1 - 1
 GoTo start
End Sub

これで 重複しないでしょう。

◎質問者からの返答

すばやい作成ありがとうございます!

試しましたが完璧です。

本当に価値のあるものができました。

ありがとうございました。

関連質問


●質問をもっと探す●



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