Zeilen mit mehreren Unterkriterien kopieren

Question

Ich arbeite an einem Makro, das ein Listenblatt für verschiedene Grafschaften durchsuchen und dann die gesamte Zeile auf dem aktuellen Blatt einfügen wird. Ich habe ein Arbeitsblatt für jede Person (Mark, John, etc.) und jeder Person sind mehrere Grafschaften zugeordnet. Mark hat drei Bezirke, die in den Zellen J1: L1 aufgelistet sind, die ich als Bereich (MyCounties) bezeichnet habe. Mein Makro durchsucht die Spalte "I" der Tabelle "Liste" für jeden dieser Bezirke und kopiert die gesamte Zeile auf Blatt "Markierung", beginnend bei "A4". Das Makro, das ich habe, funktioniert sehr gut dafür.

Für größere Gebiete wie Los Angeles County, wird es jedoch aufgeteilt zwischen 6 Personen, die jeweils verschiedene Städte in diesem Kreis nehmen, und in der Stadt LA selbst, nehmen Sie verschiedene Postleitzahlen. Ist es möglich, nach übereinstimmenden County und dann nach Stadt (für alle Städte nicht LA), sowie nach Los Angeles (Stadt) und dann Postleitzahl zu suchen? County ist die Spalte "I", City ist die Spalte "G" und Zip ist die Spalte "H". Also "Andrew" hätte in LA County Städte von Alhambra, Arcadia, etc. und auch LA (Stadt) Postleitzahlen von 90004, 90006, etc. Ich weiß, dass das unten veröffentlichte Makro wird nicht dafür funktionieren, aber gibt es a Möglichkeit, es zu bearbeiten, damit es macht, was ich will? Ich habe ein Helferblatt ("Los Angeles"), das den Namen der Person (Peter) in A1 zeigt: D1 (zusammengefügte Zellen), B3 und unten sind Counties zum Filtern, C3 und Down sind Städte zum Filtern und D3 und Down sind Postleitzahlen nach denen gefiltert werden soll. Dann überspringen wir eine Spalte und F1: I1 ist die nächste Person.

Ich habe ein Testdokument, das ich anhängen werde, sobald ich herausfinden, wie man das macht. test doc

Sub MoreReports() 
    Dim w As Long, cVar As Variant, zVar As Variant, rw As Long, sDoc As Worksheet, tDoc As Worksheet 

    With Application 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    Set sDoc = Sheets("List") 
    Set tDoc = Sheets("Peter") 
    Set cVar = Sheets("Los Angeles").Range("C3:C52") 
    Set zVar = Sheets("Los Angeles").Range("d3:d52") 


     With sDoc 
      If .AutoFilterMode Then .AutoFilterMode = False 
      With .Range(.Cells(4, "G"), .Cells(.Rows.Count, "I").End(xlUp)) 
       .AutoFilter field:=3, Criteria1:="Los Angeles", Operator:=xlAnd 
       .AutoFilter field:=1, Criteria1:=cVar, Operator:=xlFilterValues 
       .AutoFilter field:=1, Criteria1:="Los Angeles", Operator:=xlAnd 
       .AutoFilter field:=2, Criteria1:=zVar, Operator:=xlFilterValues 
       .AutoFilter field:=3, Criteria1:="Ventura", Operator:=xlFilterValues      
       With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 
        If CBool(Application.Subtotal(103, .Cells)) Then 
         .Cells.EntireRow.Copy Destination:=tDoc.Cells(rw, "A") 
        End If 
       End With 
      End With 
      If .AutoFilterMode Then .AutoFilterMode = False 
     End With 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 

End Sub 

Answer 1

Also, ich werde versuchen, ein Beispiel für diesen (Thomas) zu geben. Beachten Sie, dass ich nur auf die Stadt/PLZ schaue, da die Grafschaft diese beiden einzigartigen Werte enthalten sollte; Manche Städte können die gleiche Postleitzahl teilen.

Der Gesamtprozess I zu folgen beabsichtigen ist:

0,1) Denken Sie daran, den Bereich auf dem Referenzbogen (ich dies, so kann ich meine Spiele bis richtig eingestellt)

Sheets("Los Angeles").Range("W4:W15") 'City 
Sheets("Los Angeles").Range("X4:X15") 'Zip 

.2) Denken Sie daran, den Bereich auf der Liste Blatt

Sheets("List").Range("G6:G338") 'City 
Sheets("List").Range("H6:H338") 'Zip 

.3) Set-up Referenzen eine Schleife für die Sortierung durch Thomas'

Dim i As Integer 

For i = 15 to 4 

0,4) Innerhalb der Schleife erstellen eine weitere Schleife, die Werte in der Liste suchen

Dim j As Integer 

For j = 6 to 338 

.5) Verwenden Sie eine If-Anweisung die Bedingung

If Match(Sheets("Los Angeles").Range("W"&j),Sheets("List").Range("G"&i))=Match(Sheets("Los Angeles").Range("X"&j),Sheets("List").Range("H"&i)) Then 

.6) zu überprüfen wenn die Bedingungen erfüllt sind, dann werden wir die Zeile mit dem entsprechenden Blatt

Sheets("List").Row(j).Copy Sheets("Thomas").Row(j) 

.7) schließen, wenn Ausschneiden und einfügen -Anweisung

End If 

.8) in der Schleife zum nächsten j Gehe

Next j 

.9) Zum nächsten i in der Schleife

Next i 

.10) Filter Thomas Blatt nach Postleitzahl (sollte alle leeren Zeilen entfernen)

Sheets("Thomas").Range("A1:I338").Sort key1:=Range("H1:H338"), order1:=xlAscending, Header:=xlYes 

Mit diesem Beispiel sollten Sie in der Lage die Blätter der anderen Person aufstellen!

Insgesamt sieht es so aus (es können bessere Möglichkeiten sein, aber dies war das einfachste Spiel() Dinge, die ich von, was in meinem Kopf denken konnte, schien einfacher als die Find() Alternative):

Dim i As Integer 
Dim j As Integer 

For i = 15 to 4 
    For j = 6 to 338 

     If Match(Sheets("Los Angeles").Range("W"&j),Sheets("List").Range("G"&i))=Match(Sheets("Los Angeles").Range("X"&j),Sheets("List").Range("H"&i)) Then 
      Sheets("List").Row(j).Copy Sheets("Thomas").Row(j) 
     End If 
    Next j 
Next i