| 
    
     |  | ▼fool さん: 既にいくつも出ているので、あまりたくさん出すと
 混乱されるかもしれませんが、
 せっかく考えたので、一応載せておきます^^;
 
 
 Private Sub sample()
 Dim myDic As Object
 Dim myN As Long
 Dim myRow As Long
 Dim myLooP As Long
 Dim myLooQ As Long
 Dim myTmp As Variant
 
 
 myRow = Range("B" & Cells.Rows.Count).End(xlUp).Row
 Set myDic = CreateObject("Scripting.Dictionary")
 
 Do Until myN = myRow
 For myLooP = 1 To myRow - myN
 myTmp = ""
 For myLooQ = 0 To myN
 myTmp = myTmp & Cells(myLooP + myLooQ, 2).Value
 Next myLooQ
 myDic(myTmp) = myDic(myTmp) + 1
 Next myLooP
 myN = myN + 1
 Loop
 
 myTmp = myDic.Keys
 
 Debug.Print "パターン別個数"
 For myLooP = LBound(myTmp) To UBound(myTmp)
 Debug.Print myTmp(myLooP), myDic(myTmp(myLooP))
 Next myLooP
 Debug.Print "全パターン数 : ", UBound(myTmp) + 1
 
 Set myDic = Nothing
 End Sub
 
 結果はイミディエイトウィンドウに出力します。
 (・・・ので、件数多いと最初が消えるかも)
 一応、データ100個までテストしてみました^^
 
 参考までに。。。
 
 |  |