Excell循環問題宏FindNext

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 

的問題，從這裏開始時，即時通訊的檢索算法價值它不會僅環採取的第一個值僅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），你想要檢索數據行。如果用戶選擇了「全部」或搜索項匹配其各自的數據項，則這些條件成立。

要實現此目的，只需存儲跳過標誌，如果選擇了「全部」，並在其他任何條件爲假時移動到下一行。

下面的代碼顯示了一種做法。有幾點需要注意：

1. 將大數據集讀入數組中，因爲它操作起來要快得多。
2. 我創建了一個小小的Type結構來保持代碼整潔。這實際上只是一組相關變量的持有者。您只需在模塊的頂部定義它（在任何Subs或Functions之上）。
3. 無需逐行復制/粘貼。如果您必須粘貼（而不是直接將數組寫入輸出工作表），則可以更快地定義目標範圍並一次性複製/粘貼。
4. 你的PasteTypexlPasteFormulasAndNumberFormats看起來很奇怪 - 只要確保你確切地知道這是做什麼。
5. 您會從代碼中看到，在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)