title image


Smiley Re: Versuch per Makro
Crossposting zu herber.de siehe link!!



Sorry, ich konnte mich leider erst jetzt wieder um die Sache kümmern. Danke, dass ihr euch alle soviel Mühe mit mir gebt.





Dies http://www.herber.de/bbs/user/33259.xls, entspricht etwa dem was ich brauche aber eben als Makro. Mit der hier verwendetetn Funktion funktioniert es gut aber nur bei begrenzter Datenmenge.



Mit dem Makro von Michael unter http://spotlight.de/zforen/mse/m/mse-1146581403-5857.html komme ich noch nicht zurecht. Ich habe versucht es anzupassen, aber ich laufe von einem Bug in den nächsten.

hir meine kläglichen Bemühungen:

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("Auswertung_gesamt!B47") 'anpassen

Set Monat = Range("Auswertung_gesamt!H47") 'anpassen (Zelle, in der der Monat steht)

Set Jahr = Range("Auswertung_gesamt!I47") 'anpassen (Zelle, in der das Jahr steht)



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

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

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

Range("Auswertung_gesamt!C48:D48").Copy Ziel.Offset(0, 1)

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

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

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

bis = Range("Gesamtübersicht!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("k" & j)) = Monat And Year(Range("k" & j)) = Jahr Then

Ziel.Offset(i - Ziel.Row, 1) = Format(Range("k" & 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







Wer schafft es?

Bin aber erst morgen wieder hier, für heut bin ich am Ende!

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: