Excel VBA質問箱 IV

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

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


7998 / 13645 ツリー ←次へ | 前へ→

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

【35469】sheet内の検索・・・
質問  ton  - 06/3/5(日) 23:55 -

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

【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

【35504】Re:sheet内の検索・・・
質問  ton  - 06/3/7(火) 1:32 -

引用なし
パスワード
   すみません表示列はA〜Gです。リストボックスの表示は複数行です。

【35511】Re:sheet内の検索・・・
回答  Hirofumi  - 06/3/7(火) 9:53 -

引用なし
パスワード
   こんなのでも善いかも?

Option Explicit

'データ列数(A〜I列)
Const clngColumns As Long = 9
  
Private Sub ComboBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim lngRows As Long
  Dim vntKey As Variant
  Dim vntCopm As Variant
  Dim vntData As Variant
  Dim rngList As Range
  
  'ComboBoxからKeyを取得
  vntKey = "*" & Trim(Me.ComboBox1.Value) & "*"
  
  '探索列の位置を設定(A列からの列位置、例えば、G列なら7)
  vntCopm = Array(7, 8, 9)
  
  'データListの左上隅セル位置を基準として設定(列見出しA1のセル位置)
  Set rngList = Worksheets("Sheet1").Cells(1, "A")
  With rngList
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    'データが無い場合
    If lngRows <= 0 Then
      MsgBox "データが有りません", vbInformation
      GoTo Wayout
    End If
  End With
  
  With ListBox1
    .Clear
    'List全ての行に就いて繰り返し
    For i = 1 To lngRows
      vntData = rngList.Offset(i).Resize(, clngColumns).Value
      '1行内の探索値の有無確認
      For j = 0 To UBound(vntCopm)
        If vntData(1, vntCopm(j)) Like vntKey Then
          'ListBoxに出力
          .AddItem vntData(1, 1)
          For k = 2 To clngColumns
            .List(.ListCount - 1, k - 1) = vntData(1, k)
          Next k
        End If
      Next j
    Next i
  End With
  
Wayout:

  Set rngList = Nothing
  
End Sub

Private Sub UserForm_Initialize()

  'ComboBoxの設定
  With ComboBox1
    'Listの値を設定
    .List = Array("a", "b", "c")
  End With
  
  'ListBoxの設定
  With ListBox1
    .ColumnCount = clngColumns
  End With
  
End Sub

【35562】Re:sheet内の検索・・・
回答  太公望  - 06/3/7(火) 20:10 -

引用なし
パスワード
   皆さん今晩は。
Hirofumi さんがすでに別解を提示されていますが、これで試してみてください。
行表示にともない、かなりコードを見直しています。
重複して、行を表示しないよう工夫しています。

>すみません表示列はA〜Gです。リストボックスの表示は複数行です。


Private dic As Object

Private Sub UserForm_Initialize()
Dim rng As Range, r As Range, rn As Range
Dim vnt As Variant, v, cmbList
Dim dicChk As Object
  '
  cmbList = Array("a", "b", "c")  'ComboBox1に表示する値をセット
  With Sheets("Sheet1")
    Set rng = .Range("G1", .Range("G65536").End(xlUp))
  End With
  '
  Set dic = CreateObject("Scripting.Dictionary")
  Set dicChk = CreateObject("Scripting.Dictionary")
  '
  For Each v In cmbList
  For Each rn In rng.Cells
  For Each r In rn.Resize(1, 3)
    If r.Text Like ("*" & v & "*") Then
      If dic.exists(v) Then
        If dicChk.exists(r.Row & v) Then Exit For
        vnt = dic(v)
        ReDim Preserve vnt(UBound(vnt) + 1)
        vnt(UBound(vnt)) = Cells(r.Row, 1).Resize(1, 7).Value
      Else
        ReDim vnt(0 To 0)
        vnt(0) = Cells(r.Row, 1).Resize(1, 7).Value
      End If
      dic(v) = vnt
      dicChk(r.Row & v) = ""
    End If
  Next
  Next
  Next
  '
  ComboBox1.List = cmbList
  ComboBox1.ListIndex = 0
  '
  ListBox1.ColumnCount = 7  'ListBox1の列は7列にする
  '
  Set dicChk = Nothing
  Set rng = Nothing
End Sub

Private Sub ComboBox1_Change()
  ListBox1.List = Application.Transpose(Application. _
          Transpose(dic(ComboBox1.Value)))
End Sub

Private Sub UserForm_Terminate()
  Set dic = Nothing
End Sub

【35570】Re:sheet内の検索・・・
お礼  ton  - 06/3/7(火) 21:20 -

引用なし
パスワード
   解答ありがとうございます
入力してみたのですがうまくいきません
Option Explicit

'データ列数(A〜I列)
Const clngColumns As Long = 9
こねはどのモジュールに入れたらよいのでしょうか?

【35571】Re:sheet内の検索・・・
発言  ton  - 06/3/7(火) 21:25 -

引用なし
パスワード
   ありがとうございます
コンボボックスが2つありcombobox2はconbobox1に連動して表示選択リストが変わるように設定しています。coombobox2のデータによりシート内の検索ができるようにしたいのですが

【35577】Re:sheet内の検索・・・
発言  太公望  - 06/3/7(火) 21:58 -

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

>ありがとうございます
>コンボボックスが2つありcombobox2はconbobox1に連動して表示選択リストが変わるように設定しています。coombobox2のデータによりシート内の検索ができるようにしたいのですが

提示したコードはどうだったのでしょうか?

combobox2のデータによりシート内のどこを検索するのでしょうか?
combobox2のデータによりシート内を検索した結果どうするのでしょうか。

データの様子ややりたいことが漠然としていて、今のところ考えようがないです。

もし、今までの質問と内容がことなるのなら、別スレッドで質問されたほうがいいと思いますが?。
1つのスレッドに対し、1問1答がまとまりがよく、望ましいです。

【35578】Re:sheet内の検索・・・
発言  ton  - 06/3/7(火) 22:37 -

引用なし
パスワード
   ▼太公望 さん:
>今晩は。
>
>>ありがとうございます
>>コンボボックスが2つありcombobox2はconbobox1に連動して表示選択リストが変わるように設定しています。coombobox2のデータによりシート内の検索ができるようにしたいのですが
>
>提示したコードはどうだったのでしょうか?
>
>combobox2のデータによりシート内のどこを検索するのでしょうか?
>combobox2のデータによりシート内を検索した結果どうするのでしょうか。
>
>データの様子ややりたいことが漠然としていて、今のところ考えようがないです。
>
>もし、今までの質問と内容がことなるのなら、別スレッドで質問されたほうがいいと思いますが?。
>1つのスレッドに対し、1問1答がまとまりがよく、望ましいです。
丁寧なご回答ありがとうございます
Conbobox2によりSheet(A列〜K列、1〜600行)のセルの検索結果をListboxに表示させたいのですが、無理ですか?お願いします。

【35579】Re:sheet内の検索・・・
発言  太公望  - 06/3/7(火) 23:54 -

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

>>データの様子ややりたいことが漠然としていて、今のところ考えようがないです。
>>
>>もし、今までの質問と内容がことなるのなら、別スレッドで質問されたほうがいいと思いますが?。
>>1つのスレッドに対し、1問1答がまとまりがよく、望ましいです。

>Conbobox2によりSheet(A列〜K列、1〜600行)のセルの検索結果をListboxに表示させたいのですが、無理ですか?お願いします。

Conbobox1とConbobox2とListBox1の3つが連動して関係しているときは、しっかりと仕様が決まっていないと、結局、全体として完成したものはできません。

漠然としていて、Conbobox1とConbobox2の関係がわからないので、下記の参考コードしかできません。

これで分らなかったら、しっかりと仕様を決めて、別スレッドで質問しなおしてください。

参考までに

Private dic As Object

Private Sub UserForm_Initialize()
Dim cmbList
  cmbList = Array("X", "Y", "Z")   'ComboBox1に表示する値をセット
                    'この配列は自分で決めてください
  'ComboBox1とComboBox2の関係を決めるコードをここに書く(配列を作る)
  'このコードは自分で決めてください
  '
  ComboBox1.List = cmbList
  ComboBox1.ListIndex = 0
End Sub

Private Sub ComboBox1_Change()
Dim rng As Range, r As Range, rn As Range
Dim vnt As Variant, v, cmbList
Dim dicChk As Object
Dim cmbList2
  cmbList2 = Array("a", "b", "c")   'ComboBox2に表示する値をセット
                    'この配列はComboBox1によって変化するように
                    '自分で決めてください
  With Sheets("Sheet1")
    Set rng = .Range("A1", .Range("A65536").End(xlUp))
  End With
  '
  Set dic = CreateObject("Scripting.Dictionary")
  Set dicChk = CreateObject("Scripting.Dictionary")
  '
  For Each v In cmbList2
  For Each rn In rng.Cells
  For Each r In rn.Resize(1, 11)
    If r.Text Like ("*" & v & "*") Then
      If dic.exists(v) Then
        If dicChk.exists(r.Row & v) Then Exit For
        vnt = dic(v)
        ReDim Preserve vnt(UBound(vnt) + 1)
        vnt(UBound(vnt)) = Cells(r.Row, 1).Resize(1, 11).Value
      Else
        ReDim vnt(0 To 0)
        vnt(0) = Cells(r.Row, 1).Resize(1, 11).Value
      End If
      dic(v) = vnt
      dicChk(r.Row & v) = ""
    End If
  Next
  Next
  Next
  '
  ListBox1.ColumnCount = 11  'ListBox1を11列表示にする
  '
  Set dicChk = Nothing
  Set rng = Nothing
  
  ComboBox2.List = cmbList2
  ComboBox2.ListIndex = 0
End Sub

Private Sub ComboBox2_Change()
  ListBox1.List = Application.Transpose(Application. _
          Transpose(dic(ComboBox2.Value)))
End Sub

Private Sub UserForm_Terminate()
  Set dic = Nothing
End Sub

【35580】Re:sheet内の検索・・・
お礼  ton  - 06/3/8(水) 0:18 -

引用なし
パスワード
   何から何まで本当にありがとうございます。アドバイスを参考にがんばります
太公望さま・・・感謝です。

【35634】Re:sheet内の検索・・・
回答  Hirofumi  - 06/3/8(水) 20:21 -

引用なし
パスワード
   ▼ton さん:
>解答ありがとうございます
>入力してみたのですがうまくいきません
>Option Explicit
>
>'データ列数(A〜I列)
>Const clngColumns As Long = 9
>こねはどのモジュールに入れたらよいのでしょうか?

此れは、モジュールレベルのコードのなで、
UserFormのコードモジュール先頭、全てのSub、Functionの前に入れて下さい
Option Explicit宣言をしているなら其の後です

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