Excel VBA：嵌套循环中的FindNext

Question

我正尝试在已使用.Find的另一个循环内使用.Find函数创建一个循环。我想搜索已保存在数组中的字符串。

例如，这些是保存在Sheet1中的数组strItem中的字符串值。

"unit1", "unit2", "unit3" 

我想从Sheet2中逐一搜索它们。 Sheet2中看起来是这样的：

unit1 
unit2 
unit3 
unit1.pdf 
text1 
subject1 
subject2 
subject3 
text2 
========= 
unit2.pdf 
text1 
subject1 
subject2 
subject3 
text2 
========= 
unit3.pdf 
text1 
subject1 
subject2 
subject3 
text2 
========= 

搜索"unit1.pdf"后，我搜索所有细胞低于它“主题”，并获得subject1，2单元格的值，并3.“主题”细胞应在停止搜索下一个包含“====”的单元格。

接下来，我搜索"unit2"，如果找到像前面一样搜索“主题”单元格。再次，停止在包含“====”的单元格。等等。

在我的代码，我试图做的是字符串“单位”

• 搜索。
• 使用其.row作为开始搜索“主题”的范围。
• 返回所有科目，直到单元格包含"===="。 这是我的代码的一部分，我不能使用。

代码：

Wb2.Sheets("Sheet2").Activate 
With Wb2.Sheets("Sheet2").Range("A1:A1048575") 
    For Each strItem In arrExcelValues 
     myStr = strItem & ".pdf" 
     Set p = .Find(What:=myStr, LookIn:=xlValues, _ 
         LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False) 
     If Not p Is Nothing Then 
      firstAddress = p.Address 
      Do 
       myStr2 = p.row 
       strStart = "A" & myStr2 
       strEnd = "A1048575" 

       With Wb2.Sheets("Sheet2").Range(strStart, strEnd) 
        Set p1 = .Find(What:="Subject", LookIn:=xlValues, _ 
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False) 
        If Not p1 Is Nothing Then 
         firstAddress = p1.Address 
         Do 
          myStr2 = myStr2 + 1 
          If p1.Offset(myStr2, 0).Value = "====" Then 
           Exit Do 
          Else 
           MsgBox p1.Value & strItem 
          End If 
          Set p1 = .FindNext(p1) 
         Loop While Not p1 Is Nothing And p1.Address <> firstAddress 
        Else 
         MsgBox "Not found" 
        End If 
       End With 
        Set p = .FindNext(p) 
      Loop While Not p Is Nothing And p.Address <> firstAddress 
     Else 
      MsgBox "Not found" 
     End If 
    Next 
End With 

Answer 1

你不远了，但也有几件事情要考虑：

• 看来你知道你的数据的顺序，你可以使用它来使整个列的使用寿命比使用Find更简单。

• 除非您要深入子元素，否则不能使用嵌套的With语句。你试图完全符合要求是件好事，但要小心。例如，

  ' This is okay 
  With ThisWorkbook.Sheets("Sheet2") 
      With .Range("A1") 
       MsbBox .Value 
      End With 
      With .Range("A2") 
       MsgBox .Value 
      End With 
  End With 
  
  ' This is not okay, and present in your code 
  With ThisWorkbook.Sheets("Sheet2").Range("A1") 
      MsgBox .Value 
      With ThisWorkbook.Sheets("Sheet2").Range("A2") 
       Msgbox .Value 
      End With 
  End With 
  

我所采取的想法你的代码，重新编写它是一个更清楚一点，并希望实现你想要的。请参阅评论的详细信息：

Dim Wb2 As Workbook 
Dim lastRow As Long 
Set Wb2 = ThisWorkbook 
' Get last used row in sheet, so search isn't on entire column 
lastRow = Wb2.Sheets("Sheet2").UsedRange.Rows.Count 
' Set up array of "unit" values 
Dim arrExcelValues() As String 
arrExcelValues = Split("unit1,unit2,unit3", ",") 

' Declare variables 
Dim pdfCell As Range 
Dim eqCell As Range 
Dim eqRow As Long 
eqRow = 1 
Dim subjCell As Range 
Dim strItem As Variant 

' Loop over unit array 
With Wb2.Sheets("Sheet2") 
For Each strItem In arrExcelValues 
    ' Find the next "unitX.pdf" cell after the last equals row (equals row starts at 1) 
    Set pdfCell = .Range("A" & eqRow, "A" & lastRow).Find(what:=strItem & ".pdf", lookat:=xlPart) 
    If Not pdfCell Is Nothing Then 
     ' pdf row found, find next equals row, store row value or use last row 
     Set eqCell = .Range("A" & pdfCell.Row, "A" & lastRow).Find(what:="====", lookat:=xlPart) 
     If eqCell Is Nothing Then 
      eqRow = lastRow 
     Else 
      eqRow = eqCell.Row 
     End If 
     ' Loop through cells between pdf row and equals row 
     For Each subjCell In .Range("A" & pdfCell.Row, "A" & eqRow) 
      ' If cell contents contain the word "subject" then do something (display message) 
      If InStr(UCase(subjCell.Value), "SUBJECT") > 0 Then 
       MsgBox "Subject: " & subjCell.Value & ", Unit: " & strItem 
      End If 
     Next subjCell 
    Else 
     MsgBox "Item not found: " & strItem & ".pdf" 
    End If 
Next strItem 
End With