Excel VBA質問箱 IV

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

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


10770 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【19970】Combobox1の値を変えると、エラー
質問  kobasan  - 04/11/21(日) 11:45 -

引用なし
パスワード
   [2577]のコードを利用して、Comboboxが3つのユーザーフォームをつくりました。
Combobox1の値を変えると、下記エラーが出ます。なぜでしょうか。
(cmb.AddItem ""のコードを追加すると、一応エラーなしで動きます。
Combobox1で空白を選ぶと、動作がおかしくなるので、cmb.AddItem ""のコードは無しでやりたいです。)
原因がわかれば、また、もっと良い対策があれば教えて下さい。


シート1の構造
  A        B        C        D    E
1
2  頭字    学校名        学科        D,E列はVBAのを作業エリア
3  み        三島高校    電気
4  み        三島高校    機械
5  み        三島高校    建築
6  み        美鈴高校    普通
7  み        美鈴高校    国際
8  さ        坂本高校    普通
9  さ        坂本高校    電気
10 さ        坂本高校    機械
11 さ        坂本高校    建築
12 さ        坂女子高    普通
13 さ        坂女子高    理数
14 さ        坂女子高    衛生看護

Userform1のコードで、

  cmb.AddItem ""
  cmb.ListIndex = 0  '<=====  cmb.AddItem "" がないとエラー

「 ListIndexプロパティを設定できません。プロパティの値が不正です。」
というメッセージが出ます。

Userform1のコード
Sub set_combo_item(cmb As MSForms.ComboBox, func_str As String)
'cmb データをセットするコンボボックス
'func_str データ抽出のための関数式
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
  sw = 3
  If cmb = ComboBox3 Then sw = 4
  With Sheet1
   Set rng = .Range("a3", .Range("a65536").End(xlUp))
  End With
  rng.Offset(0, sw).Formula = func_str
  rng.Offset(0, sw) = rng.Offset(0, sw).Value
  Set rng2 = rng.Offset(0, sw).SpecialCells(xlCellTypeConstants)
  cmb.Clear
  For Each rng3 In rng2
   If rng3 <> 0 Then cmb.AddItem rng3.Value
  Next
  'cmb.AddItem ""
  cmb.ListIndex = 0  '<=====  cmb.AddItem "" がないとエラー
  Set rng = Nothing
  Set rng2 = Nothing
  Set rng3 = Nothing
  Sheet1.Range("D1") = cmb.Text
End Sub

Private Sub UserForm_Initialize()
Dim func_str As String
  func_str = "=IF(COUNTIF($A$3:A3,A3)>1,0,A3)"
  Call set_combo_item(ComboBox1, func_str)
End Sub

Private Sub ComboBox1_Change()
Dim func_str As String
  Sheet1.Range("D1") = ComboBox1.Text
  func_str = "=IF($A3=$D$1,IF(COUNTIF($B$3:B3,B3)>1,0,B3),0)"
  Call set_combo_item(ComboBox2, func_str)
End Sub

Private Sub ComboBox2_Change()
Dim func_str As String
  Sheet1.Range("E1") = ComboBox2.Text
  func_str = "=IF($B3=$E$1,$C3,0)"
  Call set_combo_item(ComboBox3, func_str)
End Sub

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

引用なし
パスワード
   善く見ていないので、ハッキリした事は解りませんが?
多分、ComboBox1の値を変更し、CmboBox2のListを替えると
1度、CmboBox2をClearしています
この時に、Sub ComboBox2_Changeのイヴェントが動きますので
当然この時点の、ComboBox2.Textは、""と成ります
因って、エラーが出るようですので

Sub ComboBox2_Changeのイヴェントを以下の様に変更すれば善いのかも?

Private Sub ComboBox2_Change()

  Dim func_str As String
  
  If ComboBox2.Text <> "" Then
    Sheet1.Range("E1") = ComboBox2.Text
    func_str = "=IF($B3=$E$1,$C3,0)"
    Call set_combo_item(ComboBox3, func_str)
  End If
  
End Sub

【19976】Re:Combobox1の値を変えると、エラー
お礼  kobasan  - 04/11/21(日) 15:58 -

引用なし
パスワード
   Hirofumi さん有り難うございます。

ねらった動きになりました。
ComboBox_Changeのイヴェントの動きについて行けなかったです。
Changeのイヴェントの動きは要注意だというのがよく分かりました。

助かりました。有り難うございます

【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

【19979】Re:Combobox1の値を変えると、エラー
お礼  kobasan  - 04/11/21(日) 22:44 -

引用なし
パスワード
   Hirofumi さん 今晩は

早速試してみました。私がねらっていたものと同等の動きをします。
すごいコードです。じっくり、コードを見ながら、勉強していきます。

有り難うございます。

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