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"行。

VBA查找下一次出现

1 个答案: