| |
もう見て居ないかな？
実際の物で試して居ないけど、作業セルを使わない方法として
こんなやり方でも出来るみたいですね？
以下は、UserFormのコードとして記述して下さい
Option Explicit
'Object変数をUserForm内の何処からでも参照出来る変数に宣言
Private dicInitial As Object
Private dicSchool As Object
Private Sub ComboBox1_Change()
Dim vntList As Variant
With ComboBox2
If ComboBox1.ListIndex > -1 Then
'指定されたキーに対応する配列を取得
vntList = dicInitial.Item(ComboBox1.Value)
'配列の行列を入れ替えComboBox2のListに代入
.List = Application.Transpose(vntList)
.ListIndex = 0
End If
End With
End Sub
Private Sub ComboBox2_Change()
Dim vntList As Variant
With ComboBox3
If ComboBox2.ListIndex > -1 Then
vntList = dicSchool.Item(ComboBox2.Value)
.List = Application.Transpose(vntList)
.ListIndex = 0
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim lngRows As Long
Dim vntData As Variant
Dim vntSchool As Variant
Dim lngSchool As Long
Dim vntSubject As Variant
Dim lngSubject As Long
Dim vntInitial As Variant
Dim lngInitial As Long
'データを配列に取得
With Sheet1.Cells(2, "A")
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
vntData = .Offset(1).Resize(lngRows, 3).Value
End With
'Dictionary オブジェクトを作成
Set dicInitial = CreateObject("Scripting.Dictionary")
Set dicSchool = CreateObject("Scripting.Dictionary")
'頭文字配列の最大添え字の初期値を設定
lngInitial = 1
'頭文字配列を確保
ReDim vntInitial(1 To lngInitial)
'頭文字配列に初期データを代入
vntInitial(lngInitial) = vntData(1, 1)
'学校名配列の最大添え字の初期値を設定
lngSchool = 1
'学校名配列を確保
ReDim vntSchool(1 To lngSchool)
'学校名配列に初期データを代入
vntSchool(lngSchool) = vntData(1, 2)
'学科配列の最大添え字の初期値を設定
lngSubject = 1
'学科配列を確保
ReDim vntSubject(1 To lngSubject)
'学科配列に初期データを代入
vntSubject(lngSubject) = vntData(1, 3)
'取得データ配列の最後まで繰り返し
For i = 2 To UBound(vntData, 1)
'学校名配列の最大添え字位置の学校名が、
'データの学校名と同じ場合（重複取り）
If vntSchool(lngSchool) = vntData(i, 2) Then
'学科配列を拡張して、'学科名を追加
lngSubject = lngSubject + 1
ReDim Preserve vntSubject(1 To lngSubject)
vntSubject(lngSubject) = vntData(i, 3)
Else
'学校名Indexに、学校名をキーとして、学科配列を登録
dicSchool.Add vntSchool(lngSchool), vntSubject
'学科配列を初期化し、新しい学科名を代入
lngSubject = 1
ReDim vntSubject(1 To lngSubject)
vntSubject(lngSubject) = vntData(i, 3)
'頭文字配列の最大添え字位置の頭文字が
'データの頭文字と同じ場合（重複取り）
If vntInitial(lngInitial) = vntData(i, 1) Then
'学校名配列を拡張し、新しい学校名を追加
lngSchool = lngSchool + 1
ReDim Preserve vntSchool(1 To lngSchool)
vntSchool(lngSchool) = vntData(i, 2)
Else
'頭文字Indexに、頭文字をキーとして学校名配列を登録
dicInitial.Add vntInitial(lngInitial), vntSchool
'頭文字配列を拡張して、頭文字を追加
lngInitial = lngInitial + 1
ReDim Preserve vntInitial(1 To lngInitial)
vntInitial(lngInitial) = vntData(i, 1)
'学校名配列を初期化して、新しい学校名を代入
lngSchool = 1
ReDim vntSchool(1 To lngSchool)
vntSchool(lngSchool) = vntData(i, 2)
End If
End If
Next i
'学校名Indexに、学校名をキーとして、学科配列を登録
dicSchool.Add vntSchool(lngSchool), vntSubject
'頭文字Indexに、頭文字をキーとして学校名配列を登録
dicInitial.Add vntInitial(lngInitial), vntSchool
With ComboBox1
.List = Application.Transpose(vntInitial)
.ListIndex = 0
End With
End Sub
Private Sub UserForm_Terminate()
Set dicInitial = Nothing
Set dicSchool = Nothing
End Sub
|
|
Hirofumi
- 04/11/21(日) 21:29 -
