無作為に5個選ぶ方法

通常、品質保証の観点から、製作した商品は全数検査します。しかし、ある省庁へ申告するための検査値については、「無作為に抽出した5台の測定結果を、その装置の代表値としてよい」という制度があります(要事前審査)。測定前に代表値で申告できるので、大変ありがたい制度です。

しかしこの「無作為に抽出した5台」が、なかなか厄介です。どうすれば「無作為」であることを担保できるのか、同制度の書類には何も書かれていません。

  • 最新のものを5つ選ぶ
  • 〇台毎に1つ選ぶ
  • 5人で1台ずつ選ぶ

などなど、どれをとっても、何らかの作為性を指摘されそうです。

そこで思い切って、Excel に選んでもらうことにしました。

Function SelectRandomRange(target_range As Range, Optional select_number As Long = 5) As Range

    If target_range.Count <= select_number Then
        Set SelectRandomRange = target_range
        Exit Function
    Else
        Dim i As Long
        Dim Dict As Scripting.Dictionary
            Set Dict = New Scripting.Dictionary
            Do
                i = Rnd * (target_range.Count)
                If i >= 1 And i <= target_range.Count Then
                    If Dict.Exists(i) = False Then
                        Dict(i) = i
                        If SelectRandomRange Is Nothing Then
                            Set SelectRandomRange = target_range(i)
                        Else
                            Set SelectRandomRange = Union(SelectRandomRange, target_range(i))
                        End If
                        If UBound(Dict.Keys) = select_number - 1 Then
                            Exit Do
                        End If
                    End If
                End If
            Loop
    End If

End Function

この関数は、指定した範囲から指定した数のセルを無作為に抽出し、それら全てを含むRangeオブジェクトを戻り値としています。

試しに、こちらでテストしてみましょう。

Sub SelectTest()
    Selection.Interior.Color = xlNone
    SelectRandomRange(Selection).Interior.Color = vbRed * 0.8
End Sub

結果、毎回異なるセルが選ばれるようになりました。

f:id:Infoment:20180805165503p:plainf:id:Infoment:20180805165613p:plainf:id:Infoment:20180805165649p:plain

なお今回は、重複を除去するためだけに連想配列(辞書)を使用しています。他の方法で重複を回避しても、全く問題ありません。

参考まで。