当我在搜索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)
答案 0 :(得分：0)
我认为你是以一种相当尴尬的方式攻击你的问题。您的代码中存在一些错误（如果我是诚实的，请列出太多错误），但我想为您提出不同的搜索结构。
如果我正确阅读了你的帖子，你想在满足三个条件时检索数据行（neg，seg和m）。如果用户选择了“全部”或搜索项与其各自的数据项匹配，则这些条件为真。
要实现这一点，如果选择“全部”，则只需存储跳过标志，如果任何其他条件为假，则移至下一行。
下面的代码向您展示了这样做的方法。需要注意几点：
Type结构来保持代码更整洁。这实际上只是一组相关变量的持有者。您只需在模块顶部定义它（在任何Subs或Functions之上）。xlPasteFormulasAndNumberFormats看起来很奇怪 - 只要确保你确切知道它在做什么。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)