Excell Schleifen Probleme Makro FindNext

Question

Hilf mir !!! .. Bei der Suche nach mCell läuft es nur mit dem ersten Wert und nicht Schleife für andere Wert, also was soll ich tun können ?.

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 

Die Probleme beginnen hier, wenn im serach für Wert, den es nur für den ersten Wert nicht nehmen Schleife nur von 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 

Um Frage einfacher Wie kann ich Schleife dieses Ding zu machen ...

.

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) 

Eigentlich fand ich die Probleme, bei denen es aber die Probleme ist, ich weiß nicht, wie es

Schleife machen

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

Ich denke, dass Sie Ihr Problem auf eine ziemlich peinliche Weise angreifen. Es gibt einige Fehler in Ihrem Code (zu viele, um sie aufzulisten, wenn ich brutal ehrlich bin), aber ich würde Ihnen gerne eine andere Suchstruktur vorschlagen.

Wenn ich Ihren Beitrag richtig gelesen habe, möchten Sie Zeilen von Daten abrufen, wenn drei Bedingungen erfüllt sind (neg, seg und m). Diese Bedingungen sind erfüllt, wenn entweder der Benutzer "Alle" ausgewählt hat oder das Suchelement mit dem entsprechenden Datenelement übereinstimmt.

Um dies zu erreichen, müssen Sie einfach speichern Flags überspringen, wenn 'All' ausgewählt ist und dann zur nächsten Zeile wechseln, wenn eine der anderen Bedingungen falsch ist.

Der folgende Code zeigt Ihnen einen Weg, dies zu tun. Ein paar Punkte zu beachten:

1. Lesen Sie den großen Datensatz in ein Array, da es viel schneller zu manipulieren ist.
2. Ich habe eine kleine Type Struktur erstellt, um den Code sauberer zu halten. Dies ist wirklich nur ein Halter für eine Gruppe verwandter Variablen. Sie definieren es einfach oben auf Ihrem Modul (über allen Subs oder Functions).
3. Es ist nicht notwendig, Zeile für Zeile zu kopieren/einfügen. Wenn Sie einfügen müssen (anstatt ein Array direkt in das Ausgabearbeitsblatt zu schreiben), ist es schneller, den Zielbereich zu definieren und alles auf einmal zu kopieren/einfügen.
4. Ihre PasteTypexlPasteFormulasAndNumberFormats sieht seltsam aus - stellen Sie nur sicher, dass Sie genau wissen, was das tut.
5. Sie werden aus dem Code sehen, dass es sehr wenig Bedarf an Select Blätter oder Zellen in VBA gibt.

Hier ist der Code - Sie können die ganze Menge in eine Module einfügen könnte:

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 

aktualisieren

Verwenden Sie diese Zeile, wenn Sie, wenn der Wert überprüfen, müssen innerhalb der Zelle enthalten ist:

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