| |
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行目から有る事に成っています
これでは、矛盾が生じるのでは？
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
