Excel VBA質問箱 IV

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

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


46197 / 76732 ←次へ | 前へ→

【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

6 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 お礼

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