Excel VBA質問箱 IV

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

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


46210 / 76735 ←次へ | 前へ→

【35499】Re:sheet内の検索・・・
回答  太公望  - 06/3/6(月) 21:48 -

引用なし
パスワード
   今晩は。

>ユーザーフォームにリストボックスとコンボボックスをつくりコンボボックスの文字列と同じ文字列を含む行をリストボックスに表示させたいのですが・・・
>ABCDEFGHIと9列あり行は600行以上あります。そしてGHIの3列のどれかに同じ
>文字列を含む(コンボ値と)行を検索してリストボックスに表示させたいのですが何かいいVBAはありますか?お願いします

検索した行のどの列をリストボックスに表示するのか不明だったので、
仮にA列を表示するようにしています。

  A  G     H    I
1 s1 a1     a1    c1
2 s2 a2     b2    c2
3 s3 a3     b3    c3

A〜GHI列にのようなデータが入っているとして動作確認しています。


Private Sub UserForm_Initialize()
  ComboBox1.List = Array("a", "b", "c")  'ComboBox1に表示する値をセット
  ComboBox1.ListIndex = 0
End Sub

Private Sub ComboBox1_Change()
Dim rng As Range, r As Range, rn As Range
Dim vnt As Variant
Dim dic As Object
Dim Chek As String
Dim clmn As String
clmn = "A" 'A列をListBox1に表示する場合。他の列を表示する場合は変更してください
  '
  Set rng = Sheets("Sheet1").Range("G1", Sheets("Sheet1").Range("G65536").End(xlUp))
  Set dic = CreateObject("Scripting.Dictionary")
  '
  For Each rn In rng.Cells
  Chek = ""
  For Each r In rn.Resize(1, 3)
    If r.Text Like ("*" & ComboBox1.Value & "*") Then
      If dic.exists(ComboBox1.Value) Then
        If Chek = Cells(r.Row, clmn).Text Then Exit For
        vnt = dic(ComboBox1.Value)
        ReDim Preserve vnt(UBound(vnt) + 1)
        vnt(UBound(vnt)) = Cells(r.Row, clmn).Text
        dic(ComboBox1.Value) = vnt
      Else
        ReDim vnt(0 To 0)
        vnt(0) = Cells(r.Row, clmn).Text
        dic(ComboBox1.Value) = vnt
        Chek = Cells(r.Row, clmn).Text
      End If
    End If
  Next
  Next
  '
  ListBox1.List = dic(ComboBox1.Value)
  '
  Set dic = Nothing
  Set r = Nothing
  Set rng = Nothing
End Sub
0 hits

【35469】sheet内の検索・・・ ton 06/3/5(日) 23:55 質問
【35499】Re:sheet内の検索・・・ 太公望 06/3/6(月) 21:48 回答
【35504】Re:sheet内の検索・・・ ton 06/3/7(火) 1:32 質問
【35511】Re:sheet内の検索・・・ Hirofumi 06/3/7(火) 9:53 回答
【35570】Re:sheet内の検索・・・ ton 06/3/7(火) 21:20 お礼
【35634】Re:sheet内の検索・・・ Hirofumi 06/3/8(水) 20:21 回答
【35562】Re:sheet内の検索・・・ 太公望 06/3/7(火) 20:10 回答
【35571】Re:sheet内の検索・・・ ton 06/3/7(火) 21:25 発言
【35577】Re:sheet内の検索・・・ 太公望 06/3/7(火) 21:58 発言
【35578】Re:sheet内の検索・・・ ton 06/3/7(火) 22:37 発言
【35579】Re:sheet内の検索・・・ 太公望 06/3/7(火) 23:54 発言
【35580】Re:sheet内の検索・・・ ton 06/3/8(水) 0:18 お礼

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