| 
    
     |  | Option Explicit 
 Private rngList As Range
 Private lngRows As Long
 
 '************************
 '画面起動時
 '************************
 Private Sub UserForm_Initialize()
 
 '  Dim dic As Object
 Dim i As Long
 '  Dim mykey As String
 Dim j As Long
 Dim vntData As Variant
 Dim vntList() As Variant
 Dim lngMax As Long
 
 '  Set dic = CreateObject("Scripting.Dictionary")
 '  With Sheets("データベース")
 '    For i = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
 '      mykey = .Cells(i, 5).Value
 '      If Not dic.Exists(mykey) Then dic.Add mykey, mykey
 '    Next
 '  End With
 '
 '  UserForm1.ComboBox1.List = dic.Keys
 '  Set dic = Nothing
 
 '  Set rngList = Sheets("データベース").Cells(1, "E") '変?
 Set rngList = Sheets("データベース").Cells(3, "E")
 With rngList
 'List行数を取得
 lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
 'E列を配列に取得
 vntData = .Resize(lngRows + 1).Value
 End With
 
 'ComboBoxのListを作成
 'List用配列を確保
 ReDim vntList(lngMax)
 '先頭データを無条件で代入
 vntList(lngMax) = vntData(1, 1)
 'E列データ2行目〜最終まで繰り返し
 For i = 2 To lngRows
 'List用配列の中を探索
 For j = 0 To lngMax
 '重複が有った場合
 If vntData(i, 1) = vntList(j) Then
 Exit For
 End If
 Next j
 '重複が無いなら
 If j > lngMax Then
 'List用配列を拡張して末尾にデータを追加
 lngMax = lngMax + 1
 ReDim Preserve vntList(lngMax)
 vntList(lngMax) = vntData(i, 1)
 End If
 Next i
 
 UserForm1.ComboBox1.List = vntList
 
 End Sub
 
 IEのバージョンが4.0or5.0?なのでは?
 遅く成るけど、取りあえず上記の様にすれば、重複なしでListが得られると思います
 
 PS:
 ただ、気に成る所が1か所有ります
 元のコードだと、ComboBoxのデータは、E列3行目から下に取っているのですが?
 UserFormで操作しているListは、データが1行目から有る事に成っています
 これでは、矛盾が生じるのでは?
 
 
 |  |