Excel VBA質問箱 IV

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

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


55330 / 76732 ←次へ | 前へ→

【26180】Re:コンボボックスの補完機能
発言  ichinose  - 05/6/25(土) 21:22 -

引用なし
パスワード
   ▼氷 さん:
こんにちは。
再投稿です。
>コンボボックスが1つの場合は出来たのですが、実はこれと同じ処理を4つ(参照するセルもバラバラ(a1〜d1))のときの処理が出来ないんです><
投稿されたコードを拝見すると大きい間違いはわかりました。

でもね、氷 さんはもう既に何度かここに質問をされていますよね?
今後の事もありますから敢えて申し上げますが、
投稿されたコードで出来ない時の現象(こんなエラーメッセージが表示される等)を
記述するようにして下さいね!!

同じような処理をするコンボボックスが増えるようなら
別の方法も考えなければなりませんが、
4つ程度の個数なら以下のようなコードでよいかと思います。
大きく前回とコードを変更しました。

対象となっているシートのシートモジュールに

'===================================
Sub settei()
'このプロシジャーは、例の
'>コンボボックスに、「かく」と入れて確定すると、かくれんぼが出てきます。
'をしないための設定
'や
'事前に氷 さんがListFillRangeにセル範囲を設定されいる事を
'想定して記述したコードです。
'一度だけ設定していただければ結構です。
'もっと言えば、ここで設定してる事はコンボボックスのプロパティの設定で
'可能です。
  With ネーム
   .ListFillRange = ""
   .MatchEntry = fmMatchEntryNone
   .Style = fmStyleDropDownCombo
   End With
  With コード
   .ListFillRange = ""
   .MatchEntry = fmMatchEntryNone
   .Style = fmStyleDropDownCombo
   End With
  ev = 0
End Sub
'======================================================
Private Sub ネーム_Change()
  Dim rng As Range
  Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
 Call set_combobox(ネーム, rng)
End Sub
'=======================================================
Private Sub ネーム_GotFocus()
  ネーム_Change
End Sub
'========================================================
Private Sub コード_Change()
  Dim rng As Range
  Set rng = Range("b1", Cells(Rows.Count, 2).End(xlUp))
  Call set_combobox(コード, rng)
End Sub
'=========================================================
Private Sub コード_GotFocus()
  コード_Change
End Sub
'=========================================================
Sub set_combobox(cmb As MSForms.ComboBox, rng As Range)
  Dim myvalue As Variant
  With cmb
   If .Text <> "" Then
     If rng.Count = 1 Then
      If rng.Value = "" Then
        .List = Array()
        Exit Sub
        End If
      End If
     myvalue = get_match_array(rng, .Text)
     .List() = Array()
     If TypeName(myvalue) <> "Integer" Then
      .List() = myvalue
      .DropDown
      End If
   Else
    
     .List() = Array()
     .SelStart = 0
     End If
   End With
End Sub
'==========================================================
Function get_match_array(rng As Range, ByVal f_str)
  Dim myarray()
  Dim crng As Range
  Dim cnt As Long
  f_str = StrConv(f_str, vbHiragana)
  cnt = 0
  For Each crng In rng
   If f_str = Mid(StrConv(crng.Text, vbHiragana), 1, Len(f_str)) Or _
    f_str = Mid(StrConv(crng.Phonetic.Text, vbHiragana), 1, Len(f_str)) Then
    ReDim Preserve myarray(1 To cnt + 1)
    myarray(cnt + 1) = crng.Text
    cnt = cnt + 1
    End If
   Next crng
  If cnt > 0 Then
   get_match_array = myarray()
  Else
   get_match_array = 0
   End If
End Function

コンボボックスのClearメソッドを使用していたので
イベントの再発生を防ぐコードにしていましたが、
Textプロパティをコードで変更する必要性がないので上記のように
しました。

コンボボックスを増やす場合は、ChangeイベントとGotfocusイベントの
追加で可能かと思います。
ChangeイベントとGotfocusイベントのどこを変更するかは
上記のコードを見て試して下さい。
2 hits

【26119】コンボボックスの補完機能 05/6/23(木) 22:48 質問
【26124】Re:コンボボックスの補完機能 ichinose 05/6/24(金) 1:24 発言
【26171】Re:コンボボックスの補完機能 05/6/25(土) 14:57 質問
【26180】Re:コンボボックスの補完機能 ichinose 05/6/25(土) 21:22 発言
【26183】Re:コンボボックスの補完機能 05/6/25(土) 22:54 お礼
【26178】Re:コンボボックスの補完機能 ponpon 05/6/25(土) 20:29 発言
【26184】Re:コンボボックスの補完機能 05/6/25(土) 22:55 発言

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