| |
業種が100や200ならこんな程度でも善いかも？
Option Explicit
'ComboBoxのデータの有るシート名を設定
Private Const cstrSheet As String = "アドレス帳"
'ComboBoxのデータの始まりのセル位置を設定
Private Const cstrTop As String = "A3"
Private Sub UserForm_Initialize()
Dim vntList As Variant
'重複取り
vntList = GetCombList(cstrSheet, cstrTop)
'戻り値が配列なら
If IsArray(vntList) Then
'ComboBoxのListに登録
ComboBox1.List = GetCombList(cstrSheet, cstrTop)
End If
End Sub
Private Function GetCombList(strSheet As String, strTop As String) As Variant
Dim i As Long
Dim j As Long
Dim lngPos As Long
Dim lngRows As Long
Dim vntData As Variant
Dim vntResult As Variant
With Worksheets(strSheet).Range(strTop)
'行数を取得
.Offset(65536 - .Row).End(xlUp).Select
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
If lngRows <= 1 And .Value = "" Then
Exit Function
End If
'データを取得
vntData = .Resize(lngRows + 1).Value
End With
'結果配列の初期の大きさを設定
ReDim vntResult(lngPos)
'結果配列に１行目を代入
vntResult(lngPos) = vntData(1, 1)
'データの最後まで繰り返し
For i = 2 To lngRows
'結果配列に同じ値が有るか確認
For j = 0 To lngPos
'同じ値が有る場合Forを抜ける
If vntResult(j) = vntData(i, 1) Then
Exit For
End If
Next j
'同じ値が無い場合
If j > lngPos Then
'結果配列の最大添え字を更新
lngPos = j
'結果配列を拡張
ReDim Preserve vntResult(lngPos)
'結果配列に登録
vntResult(lngPos) = vntData(i, 1)
End If
Next i
GetCombList = vntResult
End Function
|
|
Hirofumi
- 06/1/29(日) 17:42 -
