Excel VBA質問箱 IV

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

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


76572 / 76738 ←次へ | 前へ→

【4586】Re:キーワード入力による検索
回答  ポンタ  - 03/3/27(木) 17:19 -

引用なし
パスワード
   >ダイアログで入力を考えていました。
>表示形式は文字数字だけです。

は処理してませんが、こんな感じでどうでしょう?

標準モジュールに貼り付けて

  '検索したい文字列
  MyFindStr = Array("A", "B", "C")
  '検索するシート
  Set Ws1 = Worksheets("Sheet1")
  '貼り付けるシート
  Set Ws2 = Worksheets("Sheet2")

を書き換えてお試しください。


Sub test()
  Dim MyRange As Range, MyFind As Range
  Dim MyFindStr As Variant
  Dim i As Integer
  Dim Ws1 As Worksheet, Ws2 As Worksheet
  Dim FirstAddress As String
  '検索したい文字列
  MyFindStr = Array("A", "B", "C")
  '検索するシート
  Set Ws1 = Worksheets("Sheet1")
  '貼り付けるシート
  Set Ws2 = Worksheets("Sheet2")
  With Ws1.Cells
    For i = 0 To UBound(MyFindStr)
      Set MyFind = .Find(MyFindStr(i), , xlValue, xlWhole)
      If Not MyFind Is Nothing Then
        FirstAddress = MyFind.Address
        Do
          MyFind.Font.ColorIndex = 3
          If MyRange Is Nothing Then
            Set MyRange = MyFind
          Else
            Set MyRange = Union(MyRange, MyFind)
          End If
          Set MyFind = .FindNext(MyFind)
        Loop While Not MyFind Is Nothing And MyFind.Address <> FirstAddress
      End If
    Next
  End With
  For Each MyFind In MyRange.EntireRow.Areas
    Call MyFind.Copy(Ws2.Range("A65536").End(xlUp).Offset(1, 0))
  Next
End Sub

5 hits

【4577】キーワード入力による検索 林檎星 03/3/27(木) 14:07 質問
【4584】Re:キーワード入力による検索 Jaka 03/3/27(木) 15:24 発言
【4585】Re:キーワード入力による検索 林檎星 03/3/27(木) 16:13 発言
【4586】Re:キーワード入力による検索 ポンタ 03/3/27(木) 17:19 回答
【4589】Re:キーワード入力による検索 林檎星 03/3/27(木) 18:01 発言
【4591】Re:キーワード入力による検索 ポンタ 03/3/27(木) 20:10 回答
【4601】Re:キーワード入力による検索 Jaka 03/3/28(金) 10:19 回答
【4602】消し忘れ Jaka 03/3/28(金) 10:24 回答
【4606】Re:キーワード入力による検索 林檎星 03/3/28(金) 12:06 質問
【4607】Re:キーワード入力による検索 林檎星 03/3/28(金) 12:20 質問
【4609】Re:キーワード入力による検索 Jaka 03/3/28(金) 13:08 回答
【4613】もうひとつ・・・ 林檎星 03/3/28(金) 15:03 お礼
【4618】Re:もうひとつ・・・ Jaka 03/3/28(金) 16:25 回答
【4619】ありがとうございました。 林檎星 03/3/28(金) 17:07 お礼

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