VBA Find After 引数の使い方

Question

ひとつのブック内に同じフォームのシートが複数あり、該当するセル（【】で囲まれた値）があればをSheet1に抽出できるものを作っています。
しかし最初に該当したセルの次から検索がかかり、最初に該当したセルの情報が抜けてしまいます。
After:＝で引数を設定することを試みましたがどうしてもうまくいきません。
After:=s.Cells(Rows.Count, "B").End(xlUp)など最終行からの検索をしようと
Set rngSearch = myRange.Find(What:="【", LookAt:=xlPart, SearchOrder:=xlByColumns)のなかに設置してもうまくいきませんでした。
どのように設定すればいいかご教示いただけますと幸いです。

Sub test()
 Dim sh1 As Worksheet
 Dim rngSearch As Range
 Dim myRange As Range
 Dim strAdr As String
    Dim s As Variant
    Dim R1, R2 As Long
   On Error Resume Next
   Set sh1 = Worksheets("Sheet1")
 For Each s In ThisWorkbook.Worksheets
      R1 = sh1.Cells(Rows.Count, "A").End(xlUp).row
      R2 = s.Cells(Rows.Count, "B").End(xlUp).row
Set myRange = s.Range(s.Cells(1, "B"), s.Cells(R2, "B"))
    Set rngSearch = myRange.Find(What:="【", LookAt:=xlPart, SearchOrder:=xlByColumns)
    If Not rngSearch Is Nothing Then
        strAdr = rngSearch.Address
      n = R1 + 1
     Do
            Set rngSearch = myRange.FindNext(rngSearch)
            If rngSearch Is Nothing Then
                Exit Do
            Else
                If s.Name <> "Sheet1" And _
                strAdr <> rngSearch.Address Then
    sh1.Cells(n, "E") = Left(Mid(rngSearch, InStr(rngSearch, "【") + 1), InStr(Mid(rngSearch, InStr(rngSearch, "【") + 1), "】") - 1)
                End If
            End If
               n = n + 1
        Loop While rngSearch.Address <> strAdr
    End If
    Next
End Sub

Answer 1

VBScript.RegExp ほど高機能ではありませんが、一応Findメソッドでもワイルドカードは使えます。

Set rngSearch = myRange.Find(What:="*【*】*", LookAt:=xlWhole, SearchOrder:=xlByColumns)

ワイルドカードを使って検索（Find メソッド） | ExcelWork.info

上記以外にも、いろいろ間違っていたり、余分なコードがあるので、修正しました。
修正箇所が多いので、いちいち解説するのは大変なのて、もとコードと見比べて、どこが違っているかご自身で研究してください。

Sub test()
    Dim sh1 As Worksheet
    Dim rngSearch As Range
    Dim myRange As Range
    Dim strAdr As String
    Dim s As Variant
    Dim R1 As Long, R2 As Long
    On Error Resume Next
    Set sh1 = Worksheets("Sheet1")
    R1 = sh1.Cells(Rows.Count, "E").End(xlUp).Row + 1
    For Each s In ThisWorkbook.Worksheets
        If s.Name <> "Sheet1" Then
            R2 = s.Cells(Rows.Count, "B").End(xlUp).Row
            Set myRange = s.Range(s.Cells(1, "B"), s.Cells(R2, "B"))
            Set rngSearch = myRange.Find(What:="*【*】*", LookAt:=xlWhole, SearchOrder:=xlByColumns)
            If Not rngSearch Is Nothing Then
                strAdr = rngSearch.Address
                Do
                    sh1.Cells(R1, "E") = Left(Mid(rngSearch, InStr(rngSearch, "【") + 1), InStr(Mid(rngSearch, InStr(rngSearch, "【") + 1), "】") - 1)
                    R1 = R1 + 1
                    Set rngSearch = myRange.FindNext(rngSearch)
                Loop While rngSearch.Address <> strAdr
            End If
        End If
    Next
End Sub

ちなみに、

sh1.Cells(R1, "E") = Left(Mid(rngSearch, InStr(rngSearch, "【") + 1), InStr(Mid(rngSearch, InStr(rngSearch, "【") + 1), "】") - 1)
```の部分は、下記のように簡略化できます。
```vba
sh1.Cells(R1, "E") = Split(Split(rngSearch, "【")(1), "】")(0)

Comments

[hajihaji]

ご回答ありがとうございます。最初にヒットした情報が抽出から抜け落ちてしまいます。もし解決策があればご教示いただけますと幸いです。

[hatena19]

修正コードを追記しておきましたので、ご参照ください。

[hajihaji]

ご回答ありがとうございます。解決いたしました。無駄な部分があることを痛感いたしました。
もっと勉強するようにいたします。ありがとうございました。

Answer 2

【】で囲まれた値を抽出するだけであれば、正規表現を使うと処理がシンプルになりそうな気がします。
正規表現によるマッチング

例えば、こんなコードで

Private Sub CommandButton1_Click()
    Dim regexp As Object
    Dim i As Long
    Set regexp = CreateObject("VBScript.RegExp")
    With regexp
        .Pattern = "^【.*】$"
        .Global = True
        For i = 1 To 5
            If .Test(Cells(i, 2)) Then
                Cells(i, 1) = Cells(i, 2)
            End If
        Next
    End With
    Set regexp = Nothing
End Sub

こうなります。

Comments

[hajihaji]

ご回答ありがとうございます。調べてみます。

[hajihaji]

こういう方法もあるんですね。ありがとうございます。

[退会済みユーザー]

代理デバッグする気はないのであまりコードは追ってませんが、とりあえずFindで見つけた項目を処理せずに、すぐにFindNext呼んでるのに問題があるんじゃないですかね。もっとコードをシンプルにして、デバッグで一行づつステップ実行して動きを確認してみたらどうですかね。

[hajihaji]

ご指摘ありがとうございます。確認してみます。