219 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo an die Profis,

ich habe folgendes Problem bei folgendem Excel-Makro:

TEIL 2 funktioniert nicht in Bezug auf den Filter zweier unterschiedlicher Spalten, einmal mit "<Datum" und einmal mit ">Datum". Es kommt keine Fehlermeldung, jedoch bleibt nichts Gefiltertes übrig (alle Zeilen leer) und in der Zelle R2 wird daher der Betrag 0 ausgegeben.

(Das Filtern mit den beiden Datumsangaben habe ich durch ein aufgezeichnetes Makro übernommen.)

Darüber hinaus hätte ich gerne anstatt ein konkretes Datum den Bezug auf eine Zelle oder eine Zelle mit Namen (Namensmanager).

Ich hoffe, ihr könnt mir weiterhelfen.

Vielen Dank.

Cri

Sub Filter_mit_Datum ()

'1. TEIL FUNKTIONIERT

 ActiveSheet.Range("A1:Q1").AutoFilter Field:=3, Criteria1:="2"
 ActiveSheet.Range("A1:Q1").AutoFilter Field:=8, Criteria1:="EUR"
 ActiveSheet.Range("A1:Q1").AutoFilter Field:=6, Criteria1:= _
        xlFilterLastMonth, Operator:=xlFilterDynamic

'In Zelle R2 wird die Summe aus entspr. Spalte eingefügt
 [R2] = WorksheetFunction.Sum([G:G].SpecialCells(xlCellTypeVisible))

'Inhalt von Zelle R2 (Summe) wird in Anderes Sheet eingefügt
    Range("R2").Select
    Selection.Copy
    Worksheets("Anderes_Sheet").Activate
    Range("Tilgung_2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
Sheets("Tabelle1").ShowAllData

' 2. TEIL - DATUM-FILTER FUNKTIONIERT NICHT - Die ersten beiden Criterias schon, aber die mit dem Datum nicht:

Worksheets("Tabelle1").Activate

ActiveSheet.Range("A1:Q1").AutoFilter Field:=3, Criteria1:="2"
ActiveSheet.Range("A1:Q1").AutoFilter Field:=8, Criteria1:="EUR"
ActiveSheet.Range("A1:Q1").AutoFilter Field:=1, Criteria1:="<01.08.2022", Operator:=xlAnd
ActiveSheet.Range("A1:Q1").AutoFilter Field:=6, Criteria1:=">31.07.2022", Operator:=xlAnd

'In Zelle R2 wird die Summe aus entspr. Spalte eingefügt
 [R2] = WorksheetFunction.Sum([G:G].SpecialCells(xlCellTypeVisible))

'Inhalt von Zelle R2 (Summe) wird in anderes Sheet eingefügt
 Range("R2").Select
 Selection.Copy
 Worksheets("Anderes_Sheet").Activate
 Range("Umlauf_Monatsende_2").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False

End Sub

2 Antworten

0 Punkte
Beantwortet von m-o Profi (22.8k Punkte)

Hallo Cri,

bei dem folgenden Beispiel werden die beiden Datumswerte aus den Zellen A2 und B2 des Arbeitsblatts "Tabelle3" ausgelesen. Das musst du natürlich auf deine Verhältnisse anpassen.

Sub Filtern()
Dim Datum1 As Long
Dim Datum2 As Long
Dim lngLZeile As Long

'Hier werden die Datumswerte eingelesen - anpassen
Datum1 = Worksheets("Tabelle3").Range("A2").Value
Datum2 = Worksheets("Tabelle3").Range("B2").Value

With Worksheets("Tabelle1")
  .Activate
  'Letzte Zeile in Spalte A ermitteln
  lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row
 
  With .Range("A1:Q" & lngLZeile)
    .AutoFilter Field:=3, Criteria1:="2"
    .AutoFilter Field:=8, Criteria1:="EUR"
    .AutoFilter Field:=1, Criteria1:="<" & Datum1
    .AutoFilter Field:=6, Criteria1:=">" & Datum2
  End With
End With

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von

Hallo M.O.,

bei den Zeilen    lngLZeile = .Cells(Rows.Count, 1).End(xlUp).Row     und      With .Range("A1:Q" & lngLZeile)   hat es jeweils einen Fehlerstopp gegeben, obwohl ich "A1:Q"  in "A1:Q1"  geändert hatte. 

Das ist aber nicht schlimm.  Die Summe wird auch in meiner Version richtig berechnet. Den Operator:=xlAnd habe ich weggelassen, benötigt man ja vermutlich nur beim Filtern von zwei Kriterien innerhalb einer Spalte.

Deine Lösung     Criteria1:="<" & Datum1    für das Filtern des jeweils indirekten Datums war genau das, was ich gesucht habe, super!

Vielen Dank!

Somit  TEIL 2 wie er nun bei mir funktioniert:

Datum1 = Worksheets("Tabelle1").Range("DATUM1").Value
Datum2 = Worksheets("Tabelle3").Range("DATUM2").Value

Worksheets("Tabelle1").Activate

ActiveSheet.Range("A1:Q1").AutoFilter Field:=3, Criteria1:="2"
ActiveSheet.Range("A1:Q1").AutoFilter Field:=8, Criteria1:="EUR"
ActiveSheet.Range("A1:Q1").AutoFilter Field:=1, Criteria1:="<" & 01.08.2022"
ActiveSheet.Range("A1:Q1").AutoFilter Field:=6, Criteria1:=">" & 31.07.2022"

'In Zelle R2 wird die Summe aus entspr. Spalte eingefügt
[R2] = WorksheetFunction.Sum([G:G].SpecialCells(xlCellTypeVisible))

'Inhalt von Zelle R2 (Summe) wird in anderes Sheet eingefügt
Range("R2").Select
Selection.Copy
Worksheets("Anderes_Sheet").Activate
Range("Umlauf_Monatsende_2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False

...