Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


61374 / 76732 ←次へ | 前へ→

【19978】Re:Combobox1の値を変えると、エラー
回答  Hirofumi  - 04/11/21(日) 21:29 -

引用なし
パスワード
   もう見て居ないかな?
実際の物で試して居ないけど、作業セルを使わない方法として
こんなやり方でも出来るみたいですね?

以下は、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

3 hits

【19970】Combobox1の値を変えると、エラー kobasan 04/11/21(日) 11:45 質問
【19975】Re:Combobox1の値を変えると、エラー Hirofumi 04/11/21(日) 14:21 回答
【19976】Re:Combobox1の値を変えると、エラー kobasan 04/11/21(日) 15:58 お礼
【19978】Re:Combobox1の値を変えると、エラー Hirofumi 04/11/21(日) 21:29 回答
【19979】Re:Combobox1の値を変えると、エラー kobasan 04/11/21(日) 22:44 お礼

61374 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free