VBAで複数の.FindNextプログラミング

Question

私はVBAで比較的経験はありませんが、通常は簡単なタスクを完了できます。私は現在、.Find関数に問題があります。私はexcelが2つの.findsを行う能力を持っていないことを知っていますが、私は2番目のfindのループをコーディングする際に問題を抱えています。私がこれまで持っているコードはここにある：

Dim j As Integer 

Dim Total As Integer 
Total = Application.CountIf(Sheets("Output").Range("A:A"), "*Structure*") 

Dim class As String 
class = "CLASS =" 

Dim str As String 
str = "Structure" 

With Sheets("output") 
Set rng1 = .Range("A:A").Find(str, lookat:=xlPart) 
    row1 = rng1.Row 
Set rng2 = .Range("A:A").FindNext(rng1) 
    row2 = rng2.Row 

      For j = 6 To Total + 5 
        If Application.WorksheetFunction.CountIf(Sheets("output").Range("A" & row1 & ":A" & row2), "*" & class & "*") > 0 Then 
         Set rng3 = .Range("A" & row1 & ":A" & row2).Find(class, lookat:=xlPart) 
         Sheets("sheet2").Cells(7, j).Value = Mid(rng3, 9, 3)   
        Else 
         Sheets("sheet2").Cells(7, j).Value = "" 
        End If 
         row1 = row2 
         Set rng2 = .Range("A:A").FindNext(rng2) 
         row2 = rng2.Row 
      Next j 
End With 

私は二.Findの範囲を作成し、別のワークシート上の表に記入するために、単語「構造」の検索コードを持っています。私は問題が複数であることを知っています。見つけても、私が完全に理解できる助けを見つけることができませんでした。

Answer 1

"find all matches"の部分を別の機能に抽象化する方が簡単です。それはあなたのロジックを単純化し、実際のタスクをより簡単に管理します。

注：これは最後の "*構造体*"セルの後に "* CLASS = *"を検索しません。これを行う必要があるかどうかは不明です。

Sub Tester() 

    Dim found As Collection, i As Long, f As Range, v 

    With ActiveSheet 

     'start by finding all of the "structure" cells... 
     Set found = FindAll(.Range("A:A"), "*Structure*") 

     'then loop over them... 
     For i = 1 To found.Count - 1 

      v = "" 
      Set f = .Range("A" & found(i).Row & ":A" & _ 
           found(i + 1).Row).Find("*CLASS =*") 

      If Not f Is Nothing Then v = Mid(f, 9, 3) 
      Sheets("Sheet2").Cells(7, 5 + i).Value = v 

     Next i 

    End With 

End Sub 

FindAll機能：

Public Function FindAll(rng As Range, val As String) As Collection 
    Dim rv As New Collection, f As Range 
    Dim addr As String 

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _ 
     LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _ 
     SearchDirection:=xlNext, MatchCase:=False) 
    If Not f Is Nothing Then addr = f.Address() 

    Do Until f Is Nothing 
     rv.Add f 
     Set f = rng.FindNext(after:=f) 
     If f.Address() = addr Then Exit Do 
    Loop 

    Set FindAll = rv 
End Function