title image


Smiley Brauch nur noch ne kleine Unterstützung
Zunächst Danke für deine Mühe!

War grad noch am probieren und beim restlichen Tagesgeschäft, sorry!

Leider konnte ich deine Tabele nicht öffnen oder downloaden, unsere Sicherheitseinstellungen verhindern dies. dennoch konnte ich mit wenigen Modifikationen eine funktionierende Lösung erstellen.

Allerdings löscht er mir einen falschen Bereich.

Mit meinen geringen Kenntnissen, denke ich mal, es liegt an



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



wobei hier wohl der Bereich noch fehlerhaft definiert ist.

Gelöscht werden soll ja nur der Bereich, der vorher beschrieben wurde, also "Auswertung_gesamt!B47:D47) und dann nach unten.







Sub MonatsauswertungKfz()



'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



'Monat = InputBox("Für welchen Monat möchten Sie die Auswertung vornehmen?", "Monatszahl eingeben")

'Jahr = InputBox("Für welches Jahr möchten Sie die Auswertung vornehmen?", "Jahreszahl eingeben")



With Sheets("Auswertung_gesamt")



Set Ziel = .Range("B47") 'anpassen

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

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



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

lrow = IIf(IsEmpty(Range("Gesamtübersicht!B65536")), Range("Gesamtübersicht!B65536").End(xlUp).Row, 65536)

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

Range("Gesamtübersicht!K15:L15").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:=Range("Gesamtübersicht!B1"), LookIn:=xlValues, _

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

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

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

For j = bis To von Step -1

If Month(Range("Gesamtübersicht!K" & j)) = Monat And Year(Range("Gesamtübersicht!K" & j)) = Jahr Then

Ziel.Offset(i - Ziel.Row, 1) = Format(Range("Gesamtübersicht!K" & j), "dd.mm.yyyy")

Ziel.Offset(i - Ziel.Row, 2) = Range("Gesamtübersicht!L" & 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

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

.Activate

End With

End Sub







End Blinder mit Grüßen

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: