0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

対神エクセル!改行や余計なスペース含むキーワードの検索【ExcelVBA】

Posted at
  1. セルの幅に合わせて改行やスペースでレイアウト調整してるやつ
  2. 非表示セルを含む結合セル

スペース





神  エ  ク  セ  ル

こんなのにも対応できる検索フォーム

概要

  • 非表示範囲を含む結合セルが相手でもヒットします
  • 改行やスペースなどの余計なものがあってもヒットします
  • 検索結果一覧をユーザーフォームに表示し、

    リストをダブルクリックすると検索結果セルにジャンプします
  • 選択範囲内のみ検索します(全体を検索したければ全選択後にお願いします)
  • 大文字/小文字は完全一致でないとヒットしません

やること

ユーザーフォームの作成

  1. ユーザーフォームを挿入し、

    モジュール名をUserForm3Findに設定。

    (モジュール名は何でも良いのですが、標準モジュール上のUserForm名.showの部分と揃える)
  2. リストボックスとラベルを挿入し

    リストボックスのオブジェクト名をListBox_検索結果にする。

    (ラベルはあってもなくても良いですがキャプションに補足事項を記入した方が使用時に分かりやすい。

    ラベル例:「クリックで指定セルを選択状態/ダブルクリックで閉じます」)
  3. あとは下記コードをコピペするだけ
Private Sub UserForm_Initialize()
        Dim i As Long
        Dim Find結果
        
        For i = 0 To UBound(FindResult)
            ListBox_検索結果.AddItem FindResult(i)
        Next i
End Sub

Private Sub ListBox_検索結果_Click()
    Dim 選択項目アドレス
    
    選択項目アドレス = Split(ListBox_検索結果.Text, "::")
    With Range(選択項目アドレス(0))
        .Select
        .EntireRow.Hidden = False
    End With
End Sub

Private Sub ListBox_検索結果_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Unload Me
End Sub

標準モジュールにコードをコピペする

Public KeyWord As String
Public FindResult() As Variant
Public k As Integer


Sub 文字検索_非表示セルも余計な文字を含むやつもまとめて()
    On Error Resume Next

    Dim KeyWord As String, KW_Arr As Variant
    Dim c As Object, i As Integer
    
    Application.ScreenUpdating = False
    
    KeyWord = InputBox("検索ワードを入力してください")
    k = 0
    
    'キーワードの分解
        For i = 1 To Len(KeyWord)
           SplitKW = SplitKW & "*" & Mid(KeyWord, i, 1)
        Next i
    
    For Each c In Selection
        If c.Value Like "*" & SplitKW & "*" Then
'        If c.Value Like "*" & KeyWord & "*" Then
            ReDim Preserve FindResult(k)
            FindResult(k) = c.Address & "::" & c.Value
            k = k + 1
        End If
    Next c
    
    If k = 0 Then
        MsgBox "検索条件に一致するデータが見つかりません。"
    Else
        UserForm3Find.Show
    End If
    
    Application.ScreenUpdating = True


End Sub
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?