title image


Smiley Versuch per Makro
Hallo,



ich habe mal ein Makro dazu erstellt. Teste es bitte an einer Kopie, da auch Zellinhalte gelöscht werden. Die Daten werden nicht an derselben Stelle gefiltert, sondern in diesem Beispiel ab F15 erzeugt. Passe bitte die Daten zu Anfang des Makros an (Zelle mit Monat und Jahr sowie Zielbereich):







Sub Spezialfilter()



'Achtung, die Inhalte der Spalten des Zielbereichs werden gelöscht!

'Sicherheitskopie anlegen



Dim lrow As Long, Ziel As Range, Monat As Range, Jahr As Range

Dim i As Long, j As Long, von As Long, bis As Long



Set Ziel = Range("F15") 'anpassen

Set Monat = Range("A13") 'anpassen (Zelle, in der der Monat steht)

Set Jahr = Range("B13") 'anpassen (Zelle, in der das Jahr steht)



Range(Ziel, Ziel.Offset(0, 2)).EntireColumn.ClearContents

lrow =[b65536].End(xlUp).Row

Range("B15:B" & lrow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Ziel, Unique:=True

Range("C15:D15").Copy Ziel.Offset(0, 1)

For i = Cells(65536, Ziel.Column).End(xlUp).Row To Ziel.Row + 1 Step -1

    von = Range("B:B").Find(What:=Ziel.Offset(i - Ziel.Row), After:=[b1], LookIn:=xlValues, _

    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row

    bis = Range("B:B").Find(What:=Ziel.Offset(i - Ziel.Row), After:=[b65536], LookIn:=xlValues, _

    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For j = bis To von Step -1

        If Month(Range("C" & j)) = Monat And Year(Range("C" & j)) = Jahr Then

            Ziel.Offset(i - Ziel.Row, 1) = Format(Range("C" & j), "dd.mm.yyyy")

            Ziel.Offset(i - Ziel.Row, 2) = Range("D" & j)

            Exit For

        End If

        If j = von Then Range(Ziel.Offset(i - Ziel.Row, 0), Ziel.Offset(i - Ziel.Row, 2)).Delete

    Next j

Next i

End Sub







Code eingefügt mit Syntaxhighlighter 4.0






Gruß,



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: