VBA查找下一個發生

Question

嘿，我正在寫一個宏在VBA（我很新）。該宏查看電子表格並查找特定的列標題。然後清除任何包含零的單元格的內容。我的代碼的這一部分完全按照我想要的方式工作，唯一的問題是它不會處理多個列標題出現的位置，所以它會查找第一個標頭，清除內容並忽略第二個事件。無論是循環查找還是使用.FindNext函數，我都嘗試了多種途徑。任何幫助，將不勝感激。謝謝！我的代碼下面貼：

Sub DeleteRows2() 
Application.ScreenUpdating = True 
Dim lastrow As Long 
With ActiveSheet 
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
End With 


'~~>Start of First Instance 
'~~>dim variables and set initial values 
Dim delaymaxheader As Range 
Set delaymaxheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="DELAY Spec Max", LookAt:=xlWhole, MatchCase:=False) 
Dim delaymaxcolumn As Range 
Set delaymaxcolumn = Range(Cells(5, delaymaxheader.Column), Cells(lastrow, delaymaxheader.Column)) 
'Set delaymaxcolumn = Range(delaymaxheader.Offset(1, 0), delaymaxheader.End(xlDown)) 

'~~>dim variables and set initial values 
Dim delayminheader As Range 
Set delayminheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="DELAY Spec Min", LookAt:=xlWhole, MatchCase:=False) 
Dim delaymincolumn As Range 
Set delaymincolumn = Range(Cells(5, delayminheader.Column), Cells(lastrow, delayminheader.Column)) 
'Set delaymincolumn = Range(delayminheader.Offset(1, 0), delayminheader.End(xlDown)) 

'~~>dim variables and set initial values 
Dim phasemaxheader As Range 
Set phasemaxheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="PHASE Spec Max", LookAt:=xlWhole, MatchCase:=False) 
Dim phasemaxcolumn As Range 
Set phasemaxcolumn = Range(Cells(5, phasemaxheader.Column), Cells(lastrow, phasemaxheader.Column)) 
'Set phasemaxcolumn = Range(phasemaxheader.Offset(1, 0), phasemaxheader.End(xlDown)) 

'~~>dim variables and set initial values 
Dim phaseminheader As Range 
Set phaseminheader = Worksheets(ActiveSheet.Name).Range("A4:Z4").Find(what:="PHASE Spec Min", LookAt:=xlWhole, MatchCase:=False) 
Dim phasemincolumn As Range 
Set phasemincolumn = Range(Cells(5, phaseminheader.Column), Cells(lastrow, phaseminheader.Column)) 
'Set phasemincolumn = Range(phaseminheader.Offset(1, 0), phaseminheader.End(xlDown)) 

'~~>Loop to delete rows with zero 
'~~>Dim delaycount(5 To lastrow) As Integer 
For i = 5 To lastrow 
If Cells(i, delaymaxheader.Column) = 0 Then 
Cells(i, delaymaxheader.Column).ClearContents 
End If 
If Cells(i, delayminheader.Column) = 0 Then 
Cells(i, delayminheader.Column).ClearContents 
End If 
If Cells(i, phasemaxheader.Column) = 0 Then 
Cells(i, phasemaxheader.Column).ClearContents 
End If 
If Cells(i, phaseminheader.Column) = 0 Then 
Cells(i, phaseminheader.Column).ClearContents 
End If 


Next i 



End Sub 

Answer 1

您需要使用FindNext方法繼續前進（https://msdn.microsoft.com/en-us/library/office/ff839746.aspx）
LASTROW僅列A雖然最後一行 - 如果另一列則更進一步，會發生什麼？
另外Worksheets(ActiveSheet.Name).Range("A4:Z4")與ActiveSheet.Range("A4:Z4")相同。

Public Sub DeleteRows() 

    Dim colAllRanges As Collection 
    Dim colHeadings As Collection 

    'Declared as variants as they're used to step through the collection. 
    Dim vHeading As Variant 
    Dim vRange As Variant 
    Dim vCell As Variant 

    Dim rDelayMaxHeader As Range 
    Dim sFirstAddress As String 
    Dim lLastRow As Long 

    With ActiveSheet 
     lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
    End With 

    Set colAllRanges = New Collection 
    Set colHeadings = New Collection 
    colHeadings.Add "DELAY Spec Max" 
    colHeadings.Add "DELAY Spec Min" 
    colHeadings.Add "PHASE Spec Max" 
    colHeadings.Add "PHASE Spec Min" 

    For Each vHeading In colHeadings 
     With ActiveSheet.Range("A4:Z4") 

      'Find the first instance of the heading we're looking for. 
      Set rDelayMaxHeader = .Find(What:=vHeading, LookIn:=xlValues, LookAt:=xlWhole) 
      If Not rDelayMaxHeader Is Nothing Then 
       sFirstAddress = rDelayMaxHeader.Address 
       Do 
        'Resize the range from heading to last row and add it to the collection. 
        colAllRanges.Add rDelayMaxHeader.Resize(lLastRow - rDelayMaxHeader.Row + 1, 1) 

        'Find the next occurrence. 
        Set rDelayMaxHeader = .FindNext(rDelayMaxHeader) 

       'Keep going until nothings found or we loop back to the first address again. 
       Loop While Not rDelayMaxHeader Is Nothing And rDelayMaxHeader.Address <> sFirstAddress 
      End If 
     End With 
    Next vHeading 

    'Now to go through each cell in the range we've added to the collection and check for 0's. 
    For Each vRange In colAllRanges 
     For Each vCell In vRange 
      If vCell = 0 Then 
       vCell.ClearContents 
      End If 
     Next vCell 
    Next vRange 

End Sub 

通過上述方法，你可以添加額外列如果需要的話 - 只需添加另一個colHeadings.Add "My New Column Header"行的代碼。