Excel VBA質問箱 IV

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

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


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

【25487】データを参照して、絞り込んで行く方法(?) 05/6/2(木) 0:36 質問[未読]
【25488】Re:データを参照して、絞り込んで行く方法... ichinose 05/6/2(木) 7:51 発言[未読]
【25515】Re:データを参照して、絞り込んで行く方法... 05/6/2(木) 19:25 お礼[未読]
【38952】Re:データを参照して、絞り込んで行く方... RIKE 06/6/15(木) 10:05 質問[未読]
【38954】Re:データを参照して、絞り込んで行く方... ichinose 06/6/15(木) 10:45 発言[未読]
【38955】Re:データを参照して、絞り込んで行く方... RIKE 06/6/15(木) 11:06 お礼[未読]

【25487】データを参照して、絞り込んで行く方法(...
質問    - 05/6/2(木) 0:36 -

引用なし
パスワード
   A1にあい
A2にあき
A3にあきこ
というデータが入っていて、あるテキストボックス(リストボックスを使うのかな?)に「あ」と入力すると、そのボックスの下に

あ   <-----  ボックス
あき
あきこ

という風に表示され、さらにマウスで「あき」を選択すると、ボックスに「あき」が入り、

あき  <------  ボックス
あきこ

という風に表示されるようなプログラムを作りたいのですが、やり方が全くわかりません><

検索エンジンのオートコンプリト機能に近いと思うのですが、この処理はVBAでは可能なのでしょうか?

【25488】Re:データを参照して、絞り込んで行く方...
発言  ichinose  - 05/6/2(木) 7:51 -

引用なし
パスワード
   ▼氷 さん:
おはようございます。

>A1にあい
>A2にあき
>A3にあきこ
>というデータが入っていて、あるテキストボックス(リストボックスを使うのかな?)に「あ」と入力すると、そのボックスの下に
>
>あ   <-----  ボックス
>あき
>あきこ
>
>という風に表示され、さらにマウスで「あき」を選択すると、ボックスに「あき」が入り、
>
>あき  <------  ボックス
>あきこ
>
>という風に表示されるようなプログラムを作りたいのですが、やり方が全くわかりません><
>
>この処理はVBAでは可能なのでしょうか?
やって出来ない事はないと思います。

ユーザーフォーム(Userform1)にコンボボックス(Combobox1)を一つ配置します。

アクティブシートのA列の1行目からこのCombobox1のメンバデータが
入っているとします。

あ   --A1
あき  --A2
あきこ --A3



というように・・。

Userform1のモジュールに

'========================================================
Dim rng As Range 'リストデータのセル範囲
Dim ev As Boolean 'Changeイベントの有無フラグ True--発生可能 False---発生不可
'========================================================
Private Sub UserForm_Initialize()
  ComboBox1.Style = fmStyleDropDownCombo '←これは事前設定でよいです
  Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
  ev = True
End Sub
'===============================================================
Private Sub ComboBox1_Change()
  Dim svtext As String 'コンボボックスのTextの内容の一時保存
  If ev = False Then Exit Sub
  With ComboBox1 '←適当な名前に変更すること
   svtext = .Text
   If .Text <> "" Then
     If rng.Count = 1 Then
      If rng.Value = "" Then
        .Clear
        Exit Sub
        End If
      End If
     myvalue = Evaluate("transpose(if(mid(" & rng.Address & ",1," & Len(.Text) & ")=""" _
               & .Text & """," & rng.Address & ",""" & Chr(&HFF) & """))")
     If UCase(TypeName(myvalue)) <> UCase("variant()") Then
      myvalue = Array(myvalue)
      End If
     myvalue = Filter(myvalue, Chr(&HFF), False)
     '↑あり得ない文字を使用してフィルタをおこなう
     ev = False
     .Clear
     .List() = myvalue
     .Text = svtext
     ev = True
     If UBound(myvalue) > 0 Then
      .DropDown
      End If
   Else
     .Clear
     .Visible = False
     .Visible = True
     .SetFocus '↑ここは、こうしないと残像が残るので(Excel2000)
     End If
   End With
End Sub


以上です。
A列が更新された時(データが増えたとき)の処理はしていませんが、
A列にデータの登録などが行われた時点で処理をしなければなりません。
そうしないと追加データがコンボボックスに反映されません。

又、A列に登録されるメンバリストの数が多くなるようでしたら、
別の仕様を考えた方がよいかもしれませんよ。
400や500ぐらいの数でテストした限りは快適でしたが・・。

確認して下さい。

【25515】Re:データを参照して、絞り込んで行く方...
お礼    - 05/6/2(木) 19:25 -

引用なし
パスワード
   ichinoseさん、いつもご返信ありがとうございます^^

少しずつ理解しながら進めて行きたいと思ってるので、確認はまだ先になると思うのですが、自分で理解出来たと感じれたら、試してみます^^

本当にありがとうございましたm(_ _)m

【38952】Re:データを参照して、絞り込んで行く方...
質問  RIKE  - 06/6/15(木) 10:05 -

引用なし
パスワード
   ▼ichinose さん:
おはようございます。
初心者なもので参考にさせて頂いております。

>Userform1のモジュールに
>
>'========================================================
>Dim rng As Range 'リストデータのセル範囲
>Dim ev As Boolean 'Changeイベントの有無フラグ True--発生可能 False---発生不可
>'========================================================
>Private Sub UserForm_Initialize()
>  ComboBox1.Style = fmStyleDropDownCombo '←これは事前設定でよいです
>  Set rng = Range("a1", Cells(Rows.Count, 1).End(xlUp))
>  ev = True
>End Sub
>'===============================================================
>Private Sub ComboBox1_Change()
>  Dim svtext As String 'コンボボックスのTextの内容の一時保存
>  If ev = False Then Exit Sub
>  With ComboBox1 '←適当な名前に変更すること
>   svtext = .Text
>   If .Text <> "" Then
>     If rng.Count = 1 Then
>      If rng.Value = "" Then
>        .Clear
>        Exit Sub
>        End If
>      End If
>     myvalue = Evaluate("transpose(if(mid(" & rng.Address & ",1," & Len(.Text) & ")=""" _
>               & .Text & """," & rng.Address & ",""" & Chr(&HFF) & """))")
>     If UCase(TypeName(myvalue)) <> UCase("variant()") Then
>      myvalue = Array(myvalue)
>      End If
>     myvalue = Filter(myvalue, Chr(&HFF), False)
>     '↑あり得ない文字を使用してフィルタをおこなう
>     ev = False
>     .Clear
>     .List() = myvalue
>     .Text = svtext
>     ev = True
>     If UBound(myvalue) > 0 Then
>      .DropDown
>      End If
>   Else
>     .Clear
>     .Visible = False
>     .Visible = True
>     .SetFocus '↑ここは、こうしないと残像が残るので(Excel2000)
>     End If
>   End With
>End Sub
>
絞り込むシートを"sheet1"のB列にするとしたらどうなるのでしょうか?

>A列が更新された時(データが増えたとき)の処理はしていませんが、
>A列にデータの登録などが行われた時点で処理をしなければなりません。
>そうしないと追加データがコンボボックスに反映されません。
どのような処理をすればよいのでしょうか?

よろしくお願いします。

【38954】Re:データを参照して、絞り込んで行く方...
発言  ichinose  - 06/6/15(木) 10:45 -

引用なし
パスワード
   ▼RIKE さん:
おはようございます。
出かけてしまうので、以下でうまくいかなかったら、
どなたかお願いします。

>
>>Userform1のモジュールに
>>
>>'========================================================
>>Dim rng As Range 'リストデータのセル範囲
>>Dim ev As Boolean 'Changeイベントの有無フラグ True--発生可能 False---発生不可
>>'========================================================
>>Private Sub UserForm_Initialize()
>>  ComboBox1.Style = fmStyleDropDownCombo '←これは事前設定でよいです
   With Worksheets("sheet1")
    Set rng = .Range("b1", .Cells(.Rows.Count, "b").End(xlUp))
    End With


>>  ev = True
>>End Sub
>>'===============================================================
>>Private Sub ComboBox1_Change()
>>  Dim svtext As String 'コンボボックスのTextの内容の一時保存
   Dim r_add As String

>>  If ev = False Then Exit Sub
>>  With ComboBox1 '←適当な名前に変更すること
>>   svtext = .Text
>>   If .Text <> "" Then
>>     If rng.Count = 1 Then
>>      If rng.Value = "" Then
>>        .Clear
>>        Exit Sub
>>        End If
>>      End If
     r_add = rng.Address(, , , True)
     myvalue = Evaluate("transpose(if(mid(" & r_add & ",1," & Len(.Text) & ")=""" _
               & .Text & """," & r_add & ",""" & Chr(&HFF) & """))")

>>     If UCase(TypeName(myvalue)) <> UCase("variant()") Then
>>      myvalue = Array(myvalue)
>>      End If
>>     myvalue = Filter(myvalue, Chr(&HFF), False)
>>     '↑あり得ない文字を使用してフィルタをおこなう
>>     ev = False
>>     .Clear
>>     .List() = myvalue
>>     .Text = svtext
>>     ev = True
>>     If UBound(myvalue) > 0 Then
>>      .DropDown
>>      End If
>>   Else
>>     .Clear
>>     .Visible = False
>>     .Visible = True
>>     .SetFocus '↑ここは、こうしないと残像が残るので(Excel2000)
>>     End If
>>   End With
>>End Sub
>>
>絞り込むシートを"sheet1"のB列にするとしたらどうなるのでしょうか?


これで試してみてください。

【38955】Re:データを参照して、絞り込んで行く方...
お礼  RIKE  - 06/6/15(木) 11:06 -

引用なし
パスワード
   ▼ichinose さん:

忙しい所すみませんでした。

>これで試してみてください。
列にデータが4000近くありましたができました。
ありがとうございます。

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