Excel VBA質問箱 IV

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

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


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

【40608】検索して○をつける MIWA 06/7/18(火) 19:33 質問[未読]
【40609】Re:検索して○をつける ぴかる 06/7/18(火) 20:36 回答[未読]
【40624】Re:検索して○をつける MIWA 06/7/19(水) 12:08 お礼[未読]
【40613】Re:検索して○をつける Statis 06/7/19(水) 9:25 回答[未読]
【40625】Re:検索して○をつける MIWA 06/7/19(水) 12:10 お礼[未読]

【40608】検索して○をつける
質問  MIWA  - 06/7/18(火) 19:33 -

引用なし
パスワード
   A1に検索したい値を入力し、B列を検索させます。
見つかったら、そのセルのひとつ左のセルに○を付けたいと思っています。
複数ある場合があるので、その場合は全てに○を付け、
検索が終了したら、○が何個付いたか知らせるメッセージを表示したいです。
検索値がひとつもない場合は、ないというメッセージも表示したいです。
初心者の為、部分的には出来るのですが、これを全てつなげるとなると、
どうしてもうまくいきません。教えて下さい。

【40609】Re:検索して○をつける
回答  ぴかる  - 06/7/18(火) 20:36 -

引用なし
パスワード
   MIWAさん、こんばんは。

こんな感じでいかがです?
帰宅するんで、もうなんも出来ませんが・・・。
Sub test()
  
Dim I As Long
Dim 最終行 As Long
Dim 一致数 As Long

  最終行 = Range("B2").End(xlDown).Row
  Range(Cells(2, 1), Cells(最終行, 1)).ClearContents
  For I = 2 To 最終行
    If Range("A1").Value = Cells(I, 2).Value Then
      一致数 = 一致数 + 1
      Cells(I, 1).Value = "○"
    End If
  Next
  If 一致数 > 0 Then
    MsgBox "[" & Range("A1").Value & "]" & "との一致数は、[" & 一致数 & "]ですよん!", _
        vbInformation, "一致数チェック"
  Else
    MsgBox "[" & Range("A1").Value & "]" & "との一致したものはありまへん!", _
        vbInformation, "一致数チェック"
  End If
    
End Sub

【40613】Re:検索して○をつける
回答  Statis  - 06/7/19(水) 9:25 -

引用なし
パスワード
   こんにちは

シートのイベントで作ってみました。
該当のシートモジュールに記載
動作:セルA1に値を入力後「enter」等でセルが移動すると動作します。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Fi As Range, Ad As String, R As Range, Co As Long
With Target
   If .Cells.Count > 1 Then Exit Sub
   If .Address(0, 0) <> "A1" Then Exit Sub
   If .Value = "" Then Exit Sub
   Set R = Range("B2", Range("B65536").End(xlUp))
   Set Fi = R.Find(.Value, , xlValues, xlWhole)
   Application.EnableEvents = False
   R.Offset(, -1).ClearContents
   If Not Fi Is Nothing Then
    Ad = Fi.Address: Co = 0
    Do
     Set Fi = R.FindNext(Fi)
     Fi.Offset(, -1).Value = "○"
     Co = Co + 1
    Loop Until Ad = Fi.Address
    MsgBox "一致したデータは「" & Co & "」です。", vbInformation
   Else
    MsgBox "一致データはありませんでした。", vbInformation
   End If
   Application.EnableEvents = True
   Set Fi = Nothing
End With
End Sub

【40624】Re:検索して○をつける
お礼  MIWA  - 06/7/19(水) 12:08 -

引用なし
パスワード
   早々の回答ありがとうございました。
お陰さまで希望通りの結果が得られました。
本当にありがとうございました。

【40625】Re:検索して○をつける
お礼  MIWA  - 06/7/19(水) 12:10 -

引用なし
パスワード
   早々の回答ありがとうございました。
付けたい印が3種類あるので、そのままは使えませんでしたが、
参考になりました。ありがとうございました。

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