• 2006-06-13 03:27:57
• 回答No.2

過去問のシート名を”過去問”とします。またA列は重複のない数字とします

その前提で以下のマクロを実行してみてください

Option Explicit
Sub 問題作成()
Dim i, j, k, l, NumMAX, IntRND As Integer
Dim NO(25)
Dim SHname As Worksheet
i = 0
IntRND = Rnd(0)
NumMAX = Application.Max(Worksheets("過去問").Range("A:A"))
For Each SHname In Worksheets
If SHname.Name = "新問題" Then
i = 1
End If
Next
If i = 0 Then
Worksheets.Add.Name = "新問題"
Else
Worksheets("新問題").Range("a1:C100").ClearContents
End If

Worksheets("新問題").Range("B1") = "問題１～５"
Worksheets("新問題").Range("C1") = "なまえ"
NO(1) = 0
j = 1
Do
IntRND = Int((Rnd(Now()) * 1062347) Mod NumMAX) + 1
For i = 1 To j
If NO(i) = IntRND Then
i = 9999
End If
Next i
If i < 9999 Then
NO(j) = IntRND
j = j + 1
End If
Loop Until j > 25

For l = 2 To 26
Worksheets("新問題").Cells(l, 1) = NO(l - 1)
k = Application.Match(NO(l - 1), Worksheets("過去問").Range("A1:A2000"), 0)
Worksheets("新問題").Cells(l, 2) = Worksheets("過去問").Cells(k, 2)
Worksheets("新問題").Cells(l, 3) = Worksheets("過去問").Cells(k, 3)
Next
End Sub