| 
            Private Sub makeList1()
 '*******************************************************************
 'ランダムにリストを作成
 '*******************************************************************
 
 Dim myClmn
 myClmn = "A" '< ------------- A列
 
 Dim maxNum
 maxNum = Worksheets("makeListA").Cells(65536, myClmn).End(xlUp).Row
 
 Dim minNum
 minNum = 3 '< -------------3行目
 
 
 Dim myCtname 'リストを追加するコントロール名
 myCtname = "ListBox1"
 
 
 
 Dim i
 Dim j
 
 Dim myKey1
 Dim myKey2
 Dim myKey3
 Dim myKey4
 
 
 Controls(myCtname).Clear
 
 
 myKey1 = TextBox1.Text
 myKey2 = TextBox1.Text
 myKey3 = TextBox1.Text
 myKey4 = TextBox1.Text
 
 
 '==============================================================
 '******************************** *********************
 '==============================================================
 '====================
 '1つ目
 '====================
 myKey1 = TextBox1.Text
 '====================
 '2つ目
 '====================
 Do Until myKey1 <> myKey2
 '「Int(最大値 - 最小値 +1 ) * Rnd + 最小値」
 i = Int((maxNum - minNum + 1) * Rnd + minNum)
 myKey2 = Worksheets("makeListA").Cells(i, myClmn)
 
 If myKey1 <> myKey2 Then
 Exit Do
 End If
 
 If minNum > maxNum Then
 Exit Do
 End If
 
 Loop
 '====================
 '3つ目
 '====================
 Do Until myKey1 <> myKey2 And (myKey2 <> myKey3) And (myKey1 <> myKey3)
 '「Int(最大値 - 最小値 +1 ) * Rnd + 最小値」
 i = Int((maxNum - minNum + 1) * Rnd + minNum)
 myKey3 = Worksheets("makeListA").Cells(i, myClmn)
 
 If myKey1 <> myKey2 And (myKey2 <> myKey3) And (myKey1 <> myKey3) Then
 Exit Do
 End If
 
 If minNum > maxNum Then
 Exit Do
 End If
 Loop
 '====================
 '4つ目
 '====================
 Do Until myKey1 <> myKey2 And (myKey2 <> myKey3) And (myKey1 <> myKey4) And (myKey2 <> myKey4) And (myKey3 <> myKey4)
 '「Int(最大値 - 最小値 +1 ) * Rnd + 最小値」
 i = Int((maxNum - minNum + 1) * Rnd + minNum)
 myKey4 = Worksheets("makeListA").Cells(i, myClmn)
 
 If myKey1 <> myKey2 And (myKey2 <> myKey3) And (myKey1 <> myKey4) And (myKey2 <> myKey4) And (myKey3 <> myKey4) Then
 Exit Do
 End If
 
 If minNum > maxNum Then
 Exit Do
 End If
 
 Loop
 '=================================================================
 
 'ランダムにリストボックスに追加する
 'ランダムに並べ替えて表示
 '4パターン
 
 '「Int(最大値 - 最小値 +1 ) * Rnd + 最小値」
 j = Int((4 - 1 + 1) * Rnd + 1)  '1〜4の間で乱数を発生させる
 
 
 Select Case j
 
 Case 1  '「j = 1」のとき
 
 With Controls(myCtname)
 Controls(myCtname).AddItem myKey2
 Controls(myCtname).AddItem myKey1
 Controls(myCtname).AddItem myKey3
 Controls(myCtname).AddItem myKey4
 End With
 
 Case 2
 
 With Controls(myCtname)
 Controls(myCtname).AddItem myKey3
 Controls(myCtname).AddItem myKey4
 Controls(myCtname).AddItem myKey1
 Controls(myCtname).AddItem myKey2
 End With
 
 
 Case 3
 
 
 With Controls(myCtname)
 Controls(myCtname).AddItem myKey4
 Controls(myCtname).AddItem myKey1
 Controls(myCtname).AddItem myKey3
 Controls(myCtname).AddItem myKey2
 End With
 
 Case 4
 
 With Controls(myCtname)
 Controls(myCtname).AddItem myKey1
 Controls(myCtname).AddItem myKey3
 Controls(myCtname).AddItem myKey4
 Controls(myCtname).AddItem myKey2
 End With
 
 
 End Select
 
 
 
 End Sub
 
 |