2017-07-05 2 views
0

Ist es möglich, dass es 2 Spalten filtern wird? So wie das Land und das Datum gefiltert werden (die weniger als das heutige Datum sind) oder wenn möglich wird nur die markierte Zelle auf dem zweiten Filter gefiltert. Vielen Dank. Btw, ich benutze Ron de Bruin Codes, Urheberrechte an ihm.Excel VBA zum Filtern von 2 Spalten

Beispiel von dem, was ich suche: sample excel

Sub Send_Row_Or_Rows_2() 

Dim OutApp As Object 
Dim OutMail As Object 
Dim rng As Range 
Dim Ash As Worksheet 
Dim Cws As Worksheet 
Dim Rcount As Long 
Dim Rnum As Long 
Dim FilterRange As Range 
Dim FieldNum As Integer 

On Error GoTo cleanup 
Set OutApp = CreateObject("Outlook.Application") 

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

'Set filter sheet, you can also use Sheets("MySheet") 
Set Ash = ActiveSheet 

'Set filter range and filter column (column with e-mail addresses) 
Set FilterRange = Ash.Range("A1:H" & Ash.Rows.Count) 
FieldNum = 3 'Filter column = B because the filter range start in column A 

'Add a worksheet for the unique list and copy the unique list in A1 
Set Cws = Worksheets.Add 
FilterRange.Columns(FieldNum).AdvancedFilter _ 
     Action:=xlFilterCopy, _ 
     CopyToRange:=Cws.Range("A1"), _ 
     CriteriaRange:="", Unique:=True 

'Count of the unique values + the header cell 
Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1)) 

'If there are unique values start the loop 
If Rcount >= 2 Then 
    For Rnum = 2 To Rcount 

     'Filter the FilterRange on the FieldNum column 
     FilterRange.AutoFilter Field:=FieldNum, _ 
           Criteria1:=Cws.Cells(Rnum, 1).Value 

     'If the unique value is a mail addres create a mail 
     'If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" Then 

      With Ash.AutoFilter.Range 
       On Error Resume Next 
       Set rng = .SpecialCells(xlCellTypeVisible) 
       On Error GoTo 0 
      End With 

      Set OutMail = OutApp.CreateItem(0) 

      On Error Resume Next 
      With OutMail 
       .To = Cws.Cells(Rnum, 1).Offest(0, 1).Value 
       .Subject = "Test mail" 
       .HTMLBody = RangetoHTML(rng) 
       .Display 'Or use Send 
      End With 
      On Error GoTo 0 

      Set OutMail = Nothing 


     'Close AutoFilter 
     Ash.AutoFilterMode = False 

    Next Rnum 
End If 
+0

Was ist der Fehler, vor dem Sie stehen? Wo hast du versucht zu modifizieren? – AiRiFiEd

+0

Es funktioniert ab sofort mit nur einer Spalte gefiltert. Aber ich suche nach einem Weg, wenn es möglich ist, dass es 2 Spalten filtern kann. – Mark

+0

möchten Sie vielleicht versuchen, den folgenden Link https://StackOverflow.com/Questions/21834701/use-autofilter-on-more-than-2-criteria – AiRiFiEd

Antwort

0

Wenn Sie einmal

FilterRange.AutoFilter Field:=FieldNum, _ 
          Criteria1:=Cws.Cells(Rnum, 1).Value 

alles, was Sie es zu tun haben mit Filter weiter zu filtern, ist eine andere analoge Aussage danach schreiben:

FilterRange.AutoFilter Field:=FieldNum2, _ 
          Criteria1:= 'your criteria 

Wenn Sie dies tun, wird es auf beiden ausgewählten Spalte gefiltert werden s. Gleiches gilt für drei, vier oder mehrere andere Filter im selben Datensatz.

+0

Danke dafür aber nicht funktioniert. Nur die Header kommen heraus. – Mark

+0

Dies passiert, wenn Ihre Kriterien nicht für den Job geeignet sind. Was ist dein zweites Kriterium? –

+0

Mein zweites Kriterium filtert das Datum heraus, das <(weniger als) das heutige Datum oder wenn möglich die markierte Zelle ist. = 'Ihre Feldnummer, _ Criteria1: = "<" & date' oder 'FilterRange.AutoFilter Field: =' Ihre Feldnummer, _ Criteria1: =“ – Mark