Question

当我在搜索mCell时，它只是以第一个值运行而不是为其他值循环，那么我应该怎么办？

 Sub finddataver2()

 Dim mRange As Range
 Dim mFCell As String
 Dim mCell As Range
 Dim mName As String

 Dim sRange As Range
 Dim sFCell As String
 Dim sCell As Range
 Dim seg As String

 Dim neg As String

 Dim i As Integer
 Dim finalrow As Integer

 neg = Sheets("FindSupp").Range("C2").Value
 mName = Sheets("FindSupp").Range("C4").Value
 seg = Sheets("FindSupp").Range("C6").Value

 Sheets("FindSupp").Range("B14:L2000").ClearContents
 Worksheets("Data").Select

 finalrow = Sheets("Data").Range("A10000").End(xlUp).row

 Worksheets("Data").Select
 Set mRange = Sheets("Data").Range("I:I")
 Set mCell = mRange.Find(What:=mName, MatchCase:=False, LookAt:=xlPart)
 Worksheets("Data").Select
 Set sRange = Sheets("Data").Range("H:H")
 Set sCell = sRange.Find(What:=seg, MatchCase:=False, LookAt:=xlPart)

 Worksheets("Data").Select
 For i = 2 To finalrow

     If neg = "All" Or neg = "" Then

问题从im serach for value开始，它不循环只取mCell的第一个值

         If mName = "" Or mName = "All" Then

             If seg = "" Or seg = "All" Then
                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, ).PasteSpecial xlPasteFormulasAndNumberFormats
             ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then
                 sFCell = sCell.Address
                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
                 Set sCell = sRange.FindNext(sCell)
             End If


         ElseIf Sheets("Data").Cells(i, 9) = mCell.Value Then

             If seg = "" Or seg = "All" Then
                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

             ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then
                 sFCell = sCell.Address
                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
                 Set sCell = sRange.FindNext(sCell)

             End If

         End If

     ElseIf Sheets("Data").Cells(i, 2) = neg Then

         If mName = "" Or mName = "All" Then

             If seg = "" Or seg = "All" Then
                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

             ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then
                 sFCell = sCell.Address
                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
                 Set sCell = sRange.FindNext(sCell)
             End If


         ElseIf Sheets("Data").Cells(i, 9) = mCell.Value Then

             If seg = "" Or seg = "All" Then

                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
                 Set mCell = mRange.FindNext(mCell)

             ElseIf Sheets("Data").Cells(i, 8) = sCell.Value Then
                 sFCell = sCell.Address
                 Range(Cells(i, 1), Cells(i, 11)).Copy
                 Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

             End If

         End If

     End If

 Next i

 Worksheets("FindSupp").Select
 Cells(2, 3).Select
 Worksheets("FindSupp").Range("Z:Z").ClearContents

 End Sub

为了使问题更简单，我该如何循环这个东西......

    ElseIf Sheets("Data").Cells(i, 9) = mFCell Then

    If seg = "" Or seg = "All" Then
        Range(Cells(i, 1), Cells(i, 11)).Copy
        Sheets("FindSupp").Range("B1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        Set mCell = mRange.FindNext(mCell)

实际上，我发现了问题所在，但问题是我不知道如何让它循环

 Worksheets("Data").Select
 Set mRange = Sheets("Data").Range("I:I")
 Set mCell = mRange.Find(What:=mName, MatchCase:=False, LookAt:=xlPart)
 Worksheets("Data").Select
 Set sRange = Sheets("Data").Range("H:H")
 Set sCell = sRange.Find(What:=seg, MatchCase:=False, LookAt:=xlPart)

Answer 1

我认为你是以一种相当尴尬的方式攻击你的问题。您的代码中存在一些错误（如果我是诚实的，请列出太多错误），但我想为您提出不同的搜索结构。

如果我正确阅读了你的帖子，你想在满足三个条件时检索数据行（neg，seg和m）。如果用户选择了“全部”或搜索项与其各自的数据项匹配，则这些条件为真。

要实现这一点，如果选择“全部”，则只需存储跳过标志，如果任何其他条件为假，则移至下一行。

下面的代码向您展示了这样做的方法。需要注意几点：

将大数据集读入数组，因为操作起来要快得多。
我创建了一个小Type结构来保持代码更整洁。这实际上只是一组相关变量的持有者。您只需在模块顶部定义它（在任何Subs或Functions之上）。
无需逐行复制/粘贴。如果你必须粘贴（而不是直接将数组写入输出工作表），那么定义目标范围并一次性复制/粘贴它就会更快。
你的 PasteType xlPasteFormulasAndNumberFormats看起来很奇怪 - 只要确保你确切知道它在做什么。
您会从代码中看到，VBA中Select张或单元格的需求非常少。

以下是代码 - 您可以将整个批次粘贴到Module：

Option Explicit
Private Type SearchItems
    Value As String
    Skip As Boolean
    Index As Integer
End Type
Public Sub FindData()
    Dim item(2) As SearchItems
    Dim suppWs As Worksheet
    Dim dataWs As Worksheet
    Dim found As Boolean
    Dim data As Variant
    Dim hits As Range
    Dim r As Long
    Dim i As Integer

    'Find the boundaries of your data however you wish
    'I'm using a quick, but dirty, UsedRange object.
    'Read data into an array
    Set dataWs = ThisWorkbook.Worksheets("Data")
    data = dataWs.UsedRange.Value2

    'Set search item parameters
    Set suppWs = ThisWorkbook.Worksheets("FindSupp")
    With item(0)
        .Index = 2
        .Value = suppWs.Range("C2").Value2
        .Skip = (Len(.Value) = 0) Or (UCase(.Value) = "ALL")
    End With
    With item(1)
        .Index = 9
        .Value = suppWs.Range("C4").Value2
        .Skip = (Len(.Value) = 0) Or (UCase(.Value) = "ALL")
    End With
    With item(2)
        .Index = 8
        .Value = suppWs.Range("C6").Value2
        .Skip = (Len(.Value) = 0) Or (UCase(.Value) = "ALL")
    End With

    'Loop through the data to find the compound matches
    For r = 2 To UBound(data, 1)
        found = True
        For i = 0 To 2
            With item(i)
                If Not .Skip Then found = (data(r, .Index) = .Value)
            End With
            If Not found Then Exit For
        Next
        'Add the row to our range if all conditions are met
        If found Then Set hits = SafeUnion(hits, dataWs.Cells(r, 1).Resize(, 11))
    Next

    'Do whatever you like with the found rows
    'Your PasteSpecial PasteType is unusual but I've kept it here
    If Not hits Is Nothing Then
        hits.Copy
        suppWs.Range("B14").PasteSpecial xlPasteFormulasAndNumberFormats
    End If

End Sub
Private Function SafeUnion(rng1 As Range, rng2 As Range) As Range
    If rng1 Is Nothing Then
        Set SafeUnion = rng2
    Else
        Set SafeUnion = Union(rng1, rng2)
    End If
End Function

更新

如果您需要检查单元格中是否包含该值，请使用此行：

                If Not .Skip Then found = (InStr(data(r, .Index), .Value) > 0)

Excel循环问题宏FindNext

1 个答案: