Excel VBA乱数使用時に異なる列の重複値を避ける

Question

私は、複数のチームの名前を入力するためのワークブックと、関連する審査員（チームごとに2人）を作成しますチームの無作為化されたリストと多数のラウンドの審査員。

私が抱えている問題は、裁判官が自分のチームを判断するのを避けたいということです。

ここではブック全体を説明するのではなく、同じことをする簡単なバージョンを作成しました。サブルーチンは次の通りです：generateRandNum：セルA1：A5に重複のない乱数のリストを生成します。次にVLOOKUP関数を使用して、セルB1：B5の各番号に関連するチーム名を割り当てます。 T20：T11細胞における10名のリストの横S20：

Public Sub generateRandNum() 

lowerbound = 1 
upperbound = 5 
Set randomrange = Range("A1:A5") 

randomrange.Clear 
For Each rng1 In randomrange 
    counter = counter + 1 
Next 

If counter > upperbound - lowerbound + 1 Then 
    MsgBox ("Number of cells > number of unique random numbers") 
    Exit Sub 
End If 

For Each Rng In randomrange 
    randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound) 
    Do While Application.WorksheetFunction.CountIf(randomrange, randnum) >= 1 
     randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound) 
    Loop 
    Rng.Value = randnum 
Next 
End Sub 

generateRandJudge細胞S11において重複することなく別の乱数リストを生成します。

Public Sub generateRandJudge() 

lowerbound = 1 
upperbound = 10 
Set randomrange = Range("s11:s20") 

randomrange.Clear 
For Each rng1 In randomrange 
    counter = counter + 1 
Next 

If counter > upperbound - lowerbound + 1 Then 
    MsgBox ("Number of cells > number of unique random numbers") 
    Exit Sub 
End If 

For Each Rng In randomrange 
    randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound) 
    Do While Application.WorksheetFunction.CountIf(randomrange, randnum) >= 1 
     randnum = Int((upperbound - lowerbound + 1) * Rnd + lowerbound) 
    Loop 
    Rng.Value = randnum 
Next 
End Sub 

VLOOKUPを使用して、再び、私は名前の無作為化リストを取得し、細胞（奇数）D1にペアでそれらを配置：D5と（さえ）F1：セルE1に各裁判官に関連したチームとF5、：E5 G1：G5とする。

私は自分のチームを判断する人を避けたいので

は、私は次のように含まれるセル内の関数H1 IF：H5

= IF（OR（E1 = B1、G1 = B1）、1,0）

ユーザーがのみ生成されるランダムなリストについては、ボタンを押す必要があるように

は、私はその後、別のサブを作成：

Sub Main() 
    Call generateRandNum 
    Call generateRandJudge 
'Check Judge values against Team values to avoid duplicates 

    Dim i As Long 
    For i = 1 To Rows.Count 
    Next i 
    If Cells(i, 8).Value = 1 Then 
    Call generateRandNum 
    End If 

End Sub 

サブメイン（）の最初の部分は正常に動作しますが、最後の部分はしていません、次の行にエラーが表示されます。

If Cells(i, 8).Value = 1 Then 

私がしたいことは、セルH1：H5の値をループして1に等しい値があれば、重複がなくなるまで別のランダムなチーム番号を生成して停止するということでした。

私は誰かがこれよりはるかに洗練された解決策を持っていると思っています。誰でも助けてくれますか？

Answer 1

これはあなたが望むものと思われます。

Sub Main() 

    Dim i As Long 
    Dim sht As Excel.Worksheet 
    Dim rng As Range 

    'Call generateRandNum 
    'Call generateRandJudge 

    Set sht = ThisWorkbook.Sheets("Test") ' Change worksheet name to real name in production 

    Set rng = sht.Range("H1:H10") ' change parameters if required, or use a named range instead 

    'Check Judge values against Team values to avoid duplicates 
    With sht 
     For i = 1 To rng.Rows.Count 
      If .Cells(i, 8).Value = 1 Then Debug.Print "match at row: " & i 'Call generateRandNum 
     Next i 
    End With 
End Sub 

私はあなたの関数呼び出しをコメントアウトしましたし、名前付き範囲の代わりに、より多くの柔軟性のために固定されたものを使用することを検討してください注意してください。そうした場合、チームの数を増やすことができ、サブはまだ適切に機能します。また、一般的な規則として、私がここでやっているように、常に完全修飾参照を使用する必要があります。