Excel VBA質問箱 IV

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

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


55390 / 76738 ←次へ | 前へ→

【26124】Re:コンボボックスの補完機能
発言  ichinose  - 05/6/24(金) 1:24 -

引用なし
パスワード
   ▼氷 さん:
こんばんは。

>ワークシートに、コンボボックスを1つ作りました。
>そのコンボボックスには、A1〜A5のセルのリストが入っていて、
>A1〜A5の中身はそれぞれ、愛、アイス、書く、隠す、かくれんぼ、というものにしました。
>コンボボックスに、「かく」と入れて確定すると、かくれんぼが出てきます。
>この補完機能を消すには、どうしたら良いのでしょうか?
>後、あ、と入れるだけで(確定させずに)、あから始まる言葉(この場合は愛とアイス)がドロップダウンするようには出来るのでしょうか?
>同様に、かと入れると、書く、隠す、かくれんぼの3つがドロップダウンするようにしたいんですが・・・。
>どなたか教えて下さい><

以下のコードをコンボボックスを作成したシートの
シートモジュールに貼り付けてください。

尚、コンボボックス名はCombobox1とします
違う名前なら、コードを変更して下さい。

'=============================================================
Dim ev As Long 'Changeイベントの有無フラグ 0--発生可能 その他---発生不可
'======================================================================
Sub settei()
  ev = 1
  With ComboBox1
   .ListFillRange = ""
   .MatchEntry = fmMatchEntryNone
   .Style = fmStyleDropDownCombo '←これは事前設定でよいです
   .Text = ""
   .Clear
   
   End With
  ev = 0
End Sub
'=====================================================================
Private Sub ComboBox1_Change()
  Dim svtext As String 'コンボボックスのTextの内容の一時保存
  Dim rng As Range
  If ev > 0 Then Exit Sub
  Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
  With ComboBox1 '←適当な名前に変更すること
   svtext = .Text
   If .Text <> "" Then
     If rng.Count = 1 Then
      If rng.Value = "" Then
        .Clear
        Exit Sub
        End If
      End If
     myvalue = get_match_array(rng, .Text)
     TypeName (myvalue)
     ev = 1
     .Clear
     If TypeName(myvalue) <> "Integer" Then
      .List() = myvalue
      .DropDown
      End If
     .Text = svtext
     ev = 0
   Else
     ev=1
     .Clear
     .Visible = False
     .Visible = True
     .Activate
     ev=0
     End If
   End With
End Sub
'===============================================================
Function get_match_array(rng As Range, ByVal f_str)
'f_strの内容とセル範囲(rng)の値とフリガナを検索し、どちらかが部分一致した
'セルの内容を配列と出力する
  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


コンボボックスの入力を行う前に一度だけ、
setteiというプロシジャーを実行して下さい。

「ツール」---「マクロ」とクリックすれば、

「シート名!settei」というマクロ名が表示されるはずですから

選択して実行して下さい

その後で対象となるコンボボックスに入力して試してみて下さい。

確認して下さい。

0 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 発言

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