Supportnet / Forum / Tabellenkalkulation
Sortieren mit Makro
Frage
Hallo,
habe da mal eine frage ist es irgend wie möglich in excel 2007
mit der filterfunktion nach der übernächsten woche zu filtern..?
letzte,diese und nächste woche geht...!( nach datum)
z.b. es sind termiene in einer liste eingetragen und anhand der filterfunktion möchte ich jetzt nur die termiene sehen die übernächste woche anliegen...?! gibt es vieleicht ein makro dafür...
Sub Makro1()
'
' Makro1 Makro
'
'
ActiveSheet.Range("$B$4:$O$1504").AutoFilter Field:=6, Criteria1:= _
xlFilterThisWeek, Operator:=xlFilterDynamic
End Sub
danke schon mal für eure hilfe.
gruß nero
Antwort 1 von coros
Hallo Nero,
eine Office eigene Lösung dafür kenne ich nicht. Nachfolgend mal ein Makro, dass das aber machen sollte, was Du Dir vorstellst.
In meinem Beispiel standen die Datumswerte in Spalte A ab Zeile 2.
Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche\nTeste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Mit dem Makro wird nach Eingabe einer Wochenzahl (Zahl sagt aus, in welcher Woche ab der aktuellen gesucht werden soll) über eine Schleife geprüft, welcher Kalenderwoche das Datum in der geprüften Zelle hat. Entspricht es dem Kriterium, wird die Zeile eingeblendet. Bei allen anderen Ergebnissen wird die Zeile ausgeblendet.
Du musst das Makro noch abändern, wenn Deine Datumswerte in einer anderen Spalte stehen als in Spalte A. Dazu in der Spalte
den Spaltenbuchstaben anpassen und in Zeile
die Zahl 1 gegen die Spaltenindexzahl Deiner Spalte ändern. Die Zahl 1 steht für Spalte A, für Spalte B wäre die Zahl 2, bei C eine 3 usw.
Ich hoffe, Du meintest das so und dass Du klar kommst.
Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.
Bei Fragen melde Dich.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
eine Office eigene Lösung dafür kenne ich nicht. Nachfolgend mal ein Makro, dass das aber machen sollte, was Du Dir vorstellst.
In meinem Beispiel standen die Datumswerte in Spalte A ab Zeile 2.
Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche\nTeste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Option Explicit
Sub Filtern()
Dim Datum As Date
Dim iKrit As Integer
Dim iKWNow As Integer
Dim iKWSuch As Integer
Application.ScreenUpdating = False
Anfang:
On Error Resume Next
'Eingabe Anzahl der Wochen in der Zukunft
iKWSuch = InputBox("Bitte die Wochenzahl ab heute eintragen," _
& vbLf & vbLf & "Beispiel:" _
& vbLf & "Für übernächste Woche die Zahl 2 eintragen.")
'Wenn EIngabe nicht numersich, Meldung ausgeben
If IsNumeric(iKWSuch) = False Then
MsgBox "Erlaubte Eingabe sind nur Zahlen, Bitte Eingabe wiederholen)"
GoTo Anfang
End If
'Kalenderwoche als Filterkriterium errechnen + Wochenzahl aus Eingabe
iKWNow = DatePart("ww", Now, vbMonday, vbFirstFourDays) + iKWSuch
Cells.EntireRow.Hidden = False
'Schleife zum Finden, welche Zelle dem Filterkriterium entspricht. Alle anderen _
Zellen ausblenden
For iKrit = 2 To Range("A65536").End(xlUp).Row
If DatePart("ww", Cells(iKrit, 1), vbMonday, vbFirstFourDays) <> iKWNow Then _
Rows(iKrit).EntireRow.Hidden = True
Next
End SubMit dem Makro wird nach Eingabe einer Wochenzahl (Zahl sagt aus, in welcher Woche ab der aktuellen gesucht werden soll) über eine Schleife geprüft, welcher Kalenderwoche das Datum in der geprüften Zelle hat. Entspricht es dem Kriterium, wird die Zeile eingeblendet. Bei allen anderen Ergebnissen wird die Zeile ausgeblendet.
Du musst das Makro noch abändern, wenn Deine Datumswerte in einer anderen Spalte stehen als in Spalte A. Dazu in der Spalte
For iKrit = 2 To Range("A65536").End(xlUp).Rowden Spaltenbuchstaben anpassen und in Zeile
If DatePart("ww", Cells(iKrit, 1), vbMonday, vbFirstFourDays) <> iKWNow Then _die Zahl 1 gegen die Spaltenindexzahl Deiner Spalte ändern. Die Zahl 1 steht für Spalte A, für Spalte B wäre die Zahl 2, bei C eine 3 usw.
Ich hoffe, Du meintest das so und dass Du klar kommst.
Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.
Bei Fragen melde Dich.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 2 von nero022
Hallo Oliver
also dein makro klappt,ich habe es mal in einer anderen tabelle getestet. aber jetzt habe ich noch ein problem..!
in meiner tabelle in der ich es brauche steht zwar das datum in der zelle
aber mit einer formel dein makro erkennt wohl nicht das es ein datum ist. wie kann mann das lösen...?
danke dir schon mall für deine Hilfe!
gruß nero
also dein makro klappt,ich habe es mal in einer anderen tabelle getestet. aber jetzt habe ich noch ein problem..!
in meiner tabelle in der ich es brauche steht zwar das datum in der zelle
aber mit einer formel dein makro erkennt wohl nicht das es ein datum ist. wie kann mann das lösen...?
danke dir schon mall für deine Hilfe!
gruß nero
Antwort 3 von corosOhneCockies
Hallo Nero,
das in Deinen Zellen nicht ein Datum steht, sondern der Datumswert aus einer Formel stammt. Sollte eigentlich egal sein. Das Makro sollte trotzdem funktionieren. Um Dir zu helfen, müsste man nun Deine Datei kennen. Besteht die Möglichkeit die Datei mal z.B. bei www.netupload.de hochzuladen, damit man sich ansehen kann, warum bei Dir das Makro nicht funktioniert? Denn alles andere ist wie mit langen Stangen im Nebel stochern.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
das in Deinen Zellen nicht ein Datum steht, sondern der Datumswert aus einer Formel stammt. Sollte eigentlich egal sein. Das Makro sollte trotzdem funktionieren. Um Dir zu helfen, müsste man nun Deine Datei kennen. Besteht die Möglichkeit die Datei mal z.B. bei www.netupload.de hochzuladen, damit man sich ansehen kann, warum bei Dir das Makro nicht funktioniert? Denn alles andere ist wie mit langen Stangen im Nebel stochern.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 4 von nero022
hallo Oliver
habe dir mal eine E-Mail zu kommen lassen..
hoffe es ist ok.
gruß nero
habe dir mal eine E-Mail zu kommen lassen..
hoffe es ist ok.
gruß nero
Antwort 5 von coros
Hallo Nero,
das mit der Mail ist schon OK.
Das Problem in Deiner Datei ist, dass Du in der Codezeile
als letzte zu durchsuchende Zeile die Zeile 1504 angegeben hast. Da aber bis zu dieser Zeile auch Werte stehen, wird nicht die letzte Zeile ermittelt. Du musst dort die Zahl "1505", also eine Zeile weiter angeben. Dann wird als letzte Zeile die zurückgegeben, in der der letzte Wert, also bei Dir die Zeile 1504, steht. Ändere den Wert und es wird funktionieren.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
das mit der Mail ist schon OK.
Das Problem in Deiner Datei ist, dass Du in der Codezeile
For iKrit = 5 To Range("G1504").End(xlUp).Rowals letzte zu durchsuchende Zeile die Zeile 1504 angegeben hast. Da aber bis zu dieser Zeile auch Werte stehen, wird nicht die letzte Zeile ermittelt. Du musst dort die Zahl "1505", also eine Zeile weiter angeben. Dann wird als letzte Zeile die zurückgegeben, in der der letzte Wert, also bei Dir die Zeile 1504, steht. Ändere den Wert und es wird funktionieren.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 6 von nero022
danke Oliver
es hat geklapt,auser das ich erst auf alle daten anzeigen gehen muß
und dan erst filtern kann..!und nicht erst aus dieser oder nächster woche. aber das ist schon ok denke das es mir so reicht.
danke noch mal für deine hilfe !
hoffe wenn ich noch mal eine frage habe das ich mich mal per e-Mail
bei dir melden kann.
gruß nero.
es hat geklapt,auser das ich erst auf alle daten anzeigen gehen muß
und dan erst filtern kann..!und nicht erst aus dieser oder nächster woche. aber das ist schon ok denke das es mir so reicht.
danke noch mal für deine hilfe !
hoffe wenn ich noch mal eine frage habe das ich mich mal per e-Mail
bei dir melden kann.
gruß nero.
Antwort 7 von coros
Hallo Nero,
das leigt daran, dass in Deiner Datei immer der AutoFilter aktiv ist. Der sollte beim Ausführen des Makros automatisch deaktiviert werden. Das Makro sieht dan wie folgt aus.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
das leigt daran, dass in Deiner Datei immer der AutoFilter aktiv ist. Der sollte beim Ausführen des Makros automatisch deaktiviert werden. Das Makro sieht dan wie folgt aus.
Option Explicit
Sub Filtern()
Dim Datum As Date
Dim iKrit As Integer
Dim iKWNow As Integer
Dim iKWSuch As Integer
Application.ScreenUpdating = False
Anfang:
On Error Resume Next
'Eingabe Anzahl der Wochen in der Zukunft
iKWSuch = InputBox("Bitte die Wochenzahl ab heute eintragen," _
& vbLf & vbLf & "Beispiel:" _
& vbLf & "Für übernächste Woche die Zahl 2 eintragen.")
'Wenn EIngabe nicht numersich, Meldung ausgeben
If IsNumeric(iKWSuch) = False Then
MsgBox "Erlaubte Eingabe sind nur Zahlen, Bitte Eingabe wiederholen)"
GoTo Anfang
End If
'Kalenderwoche als Filterkriterium errechnen + Wochenzahl aus Eingabe
iKWNow = DatePart("ww", Now, vbMonday, vbFirstFourDays) + iKWSuch
'Wenn Autofilter aktiv, diesen deaktivieren
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'Alle Zeilen einblenden
Cells.EntireRow.Hidden = False
'Schleife zum Finden, welche Zelle dem Filterkriterium entspricht. Alle anderen _
Zellen ausblenden
For iKrit = 5 To Range("G1505").End(xlUp).Row
If DatePart("ww", Cells(iKrit, 7), vbMonday, vbFirstFourDays) <> iKWNow Then _
Rows(iKrit).EntireRow.Hidden = True
Next
End SubMfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 8 von nero022
hallo oliver,
habe es jetzt mal mit diesem makro versucht es geht,jetzt ist mir leider
noch eine sache aufgefallen.
die werte die im datumsbereich stehen (rechts weiter) werden wenn
ich das filter aktiviere alle zusammengerechnet und nicht nur die werte die gerade angezeigt werden...!
wenn ich meine filter verwende werden nur die zellen berechnet die angezeigt werden.
könntest du mir vieleicht dafür auch eine lösung sagen...?
danke schon mal
gruß nero.!
habe es jetzt mal mit diesem makro versucht es geht,jetzt ist mir leider
noch eine sache aufgefallen.
die werte die im datumsbereich stehen (rechts weiter) werden wenn
ich das filter aktiviere alle zusammengerechnet und nicht nur die werte die gerade angezeigt werden...!
wenn ich meine filter verwende werden nur die zellen berechnet die angezeigt werden.
könntest du mir vieleicht dafür auch eine lösung sagen...?
danke schon mal
gruß nero.!
Antwort 9 von coros
Hallo Nero,
ich gehe mal davon aus, dass Du die Formelsummen in Zeile 1511 meinst. Dann muss durch das Makro die Summe für die Felder berechnet werden. Das Makro sieht dann wie folgt aus:
Da durch das Makro allerdings die Formeln in den Zellen durch Werte überschrieben werden, muss bei Betätigen der anderen Schaltflächen die Formel wieder eingetragen werden. Dazu musst Du bei den anderen Makros, die also den Filter aktivieren, die Codezeilen
einsetzen. Dadurch werden die alten Formeln wieder eingetragen.
Wobei Du diese anderen Schaltflächen eigentlich nicht benötigst, da das was diese Schaltflächen filtern, das obige Makro ebenfalls macht. Du musst für letzte Woche die Zahl -1, für die aktuelle Woche die 0 usw. eingeben. Somit sehe ich in den anderen Schaltflächen im Moment keinen Sinn mehr.
Bei Fragen melde Dich.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
ich gehe mal davon aus, dass Du die Formelsummen in Zeile 1511 meinst. Dann muss durch das Makro die Summe für die Felder berechnet werden. Das Makro sieht dann wie folgt aus:
Option Explicit
Sub Filtern()
Dim Datum As Date
Dim iKrit As Integer
Dim iKWNow As Integer
Dim iKWSuch As Integer
Dim varMinWerteSpalteI As Variant
Dim varMinWerteSpalteJ As Variant
Dim varMinWerteSpalteK As Variant
Dim varMinWerteSpalteL As Variant
Dim varMinWerteSpalteM As Variant
Dim varMinWerteSpalteN As Variant
Dim varMinWerteSpalteO As Variant
Application.ScreenUpdating = False
Anfang:
On Error Resume Next
'Eingabe Anzahl der Wochen in der Zukunft
iKWSuch = InputBox("Bitte die Wochenzahl ab heute eintragen," _
& vbLf & vbLf & "Beispiel:" _
& vbLf & "Für übernächste Woche die Zahl 2 eintragen.")
'Wenn EIngabe nicht numersich, Meldung ausgeben
If IsNumeric(iKWSuch) = False Then
MsgBox "Erlaubte Eingabe sind nur Zahlen, Bitte Eingabe wiederholen)"
GoTo Anfang
End If
'Kalenderwoche als Filterkriterium errechnen + Wochenzahl aus Eingabe
iKWNow = DatePart("ww", Now, vbMonday, vbFirstFourDays) + iKWSuch
'Wenn Autofilter aktiv, diesen deaktivieren
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'Alle Zeilen einblenden
Cells.EntireRow.Hidden = False
'Schleife zum Finden, welche Zelle dem Filterkriterium entspricht. Alle anderen _
Zellen ausblenden
For iKrit = 5 To Range("G1505").End(xlUp).Row
If DatePart("ww", Cells(iKrit, 7), vbMonday, vbFirstFourDays) <> iKWNow Then
Rows(iKrit).EntireRow.Hidden = True
Else
varMinWerteSpalteI = varMinWerteSpalteI + Cells(iKrit, 9)
varMinWerteSpalteJ = varMinWerteSpalteJ + Cells(iKrit, 10)
varMinWerteSpalteK = varMinWerteSpalteK + Cells(iKrit, 11)
varMinWerteSpalteL = varMinWerteSpalteL + Cells(iKrit, 12)
varMinWerteSpalteM = varMinWerteSpalteM + Cells(iKrit, 13)
varMinWerteSpalteN = varMinWerteSpalteN + Cells(iKrit, 14)
varMinWerteSpalteO = varMinWerteSpalteO + Cells(iKrit, 15)
End If
Next
Range("D1511") = varMinWerteSpalteI
Range("E1511") = varMinWerteSpalteJ
Range("F1511") = varMinWerteSpalteK
Range("G1511") = varMinWerteSpalteL
Range("H1511") = varMinWerteSpalteM
Range("I1511") = varMinWerteSpalteN
Range("J1511") = varMinWerteSpalteO
End SubDa durch das Makro allerdings die Formeln in den Zellen durch Werte überschrieben werden, muss bei Betätigen der anderen Schaltflächen die Formel wieder eingetragen werden. Dazu musst Du bei den anderen Makros, die also den Filter aktivieren, die Codezeilen
Range("D1511").FormulaLocal = "=TEILERGEBNIS(9;I5:I1504)-I1508"
Range("E1511").FormulaLocal = "=TEILERGEBNIS(9;J5:J1504)-J1508"
Range("F1511").FormulaLocal = "=TEILERGEBNIS(9;K5:K1504)-K1508"
Range("G1511").FormulaLocal = "=TEILERGEBNIS(9;L5:L1504)-L1508"
Range("H1511").FormulaLocal = "=TEILERGEBNIS(9;M5:M1504)-M1508"
Range("I1511").FormulaLocal = "=TEILERGEBNIS(9;N5:N1504)-N1508"
Range("J1511").FormulaLocal = "=TEILERGEBNIS(9;O5:O1504)-O1508"einsetzen. Dadurch werden die alten Formeln wieder eingetragen.
Wobei Du diese anderen Schaltflächen eigentlich nicht benötigst, da das was diese Schaltflächen filtern, das obige Makro ebenfalls macht. Du musst für letzte Woche die Zahl -1, für die aktuelle Woche die 0 usw. eingeben. Somit sehe ich in den anderen Schaltflächen im Moment keinen Sinn mehr.
Bei Fragen melde Dich.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 10 von nero022
Hallo Oliver
habe dein makro in meiner testdatei mal ausprobiert,
es geht sehr gut.
aber leider kann ich auf die andern makros nicht verzichten..
da ich noch eine fabsummen berechnung habe die in den zeilen
I1508 bis O1508 berechnet werden auch über einem makro.
und dann in D1511 bis J1511 abgezogen werden wenn die zellen
oben gelb makiert sind...!
kann man das auch noch in deinem makro unterbringen ..?
Danke nochmals für deine hilfe..!
gruß nero
habe dein makro in meiner testdatei mal ausprobiert,
es geht sehr gut.
aber leider kann ich auf die andern makros nicht verzichten..
da ich noch eine fabsummen berechnung habe die in den zeilen
I1508 bis O1508 berechnet werden auch über einem makro.
und dann in D1511 bis J1511 abgezogen werden wenn die zellen
oben gelb makiert sind...!
kann man das auch noch in deinem makro unterbringen ..?
Danke nochmals für deine hilfe..!
gruß nero
Antwort 11 von coros
Hallo Nero,
hier das Makro, dass Dir zusätzlich die Farbsummen in der Zeile 1508 einfügt.
Um wieder die alten Formeln einzutragen erweitere Deine Makros um die Zeilen
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
hier das Makro, dass Dir zusätzlich die Farbsummen in der Zeile 1508 einfügt.
Option Explicit
Sub Filtern()
Dim Datum As Date
Dim iKrit As Integer
Dim iKWNow As Integer
Dim iKWSuch As Integer
Dim varMinWerteSpalteI As Variant
Dim varMinWerteSpalteJ As Variant
Dim varMinWerteSpalteK As Variant
Dim varMinWerteSpalteL As Variant
Dim varMinWerteSpalteM As Variant
Dim varMinWerteSpalteN As Variant
Dim varMinWerteSpalteO As Variant
Dim varFarbsummeSpalteI As Variant
Dim varFarbsummeSpalteJ As Variant
Dim varFarbsummeSpalteK As Variant
Dim varFarbsummeSpalteL As Variant
Dim varFarbsummeSpalteM As Variant
Dim varFarbsummeSpalteN As Variant
Dim varFarbsummeSpalteO As Variant
Application.ScreenUpdating = False
Anfang:
On Error Resume Next
'Eingabe Anzahl der Wochen in der Zukunft
iKWSuch = InputBox("Bitte die Wochenzahl ab heute eintragen," _
& vbLf & vbLf & "Beispiel:" _
& vbLf & "Für übernächste Woche die Zahl 2 eintragen.")
'Wenn EIngabe nicht numersich, Meldung ausgeben
If IsNumeric(iKWSuch) = False Then
MsgBox "Erlaubte Eingabe sind nur Zahlen, Bitte Eingabe wiederholen)"
GoTo Anfang
End If
'Kalenderwoche als Filterkriterium errechnen + Wochenzahl aus Eingabe
iKWNow = DatePart("ww", Now, vbMonday, vbFirstFourDays) + iKWSuch
'Wenn Autofilter aktiv, diesen deaktivieren
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'Alle Zeilen einblenden
Cells.EntireRow.Hidden = False
'Schleife zum Finden, welche Zelle dem Filterkriterium entspricht. Alle anderen _
Zellen ausblenden
For iKrit = 5 To Range("G1505").End(xlUp).Row
If DatePart("ww", Cells(iKrit, 7), vbMonday, vbFirstFourDays) <> iKWNow Then
Rows(iKrit).EntireRow.Hidden = True
Else
varMinWerteSpalteI = varMinWerteSpalteI + Cells(iKrit, 9)
varMinWerteSpalteJ = varMinWerteSpalteJ + Cells(iKrit, 10)
varMinWerteSpalteK = varMinWerteSpalteK + Cells(iKrit, 11)
varMinWerteSpalteL = varMinWerteSpalteL + Cells(iKrit, 12)
varMinWerteSpalteM = varMinWerteSpalteM + Cells(iKrit, 13)
varMinWerteSpalteN = varMinWerteSpalteN + Cells(iKrit, 14)
varMinWerteSpalteO = varMinWerteSpalteO + Cells(iKrit, 15)
If Cells(iKrit, 9).Interior.ColorIndex = 6 Then
varFarbsummeSpalteI = varFarbsummeSpalteI + Cells(iKrit, 9)
End If
If Cells(iKrit, 10).Interior.ColorIndex = 6 Then
varFarbsummeSpalteJ = varFarbsummeSpalteJ + Cells(iKrit, 10)
End If
If Cells(iKrit, 11).Interior.ColorIndex = 6 Then
varFarbsummeSpalteK = varFarbsummeSpalteK + Cells(iKrit, 11)
End If
If Cells(iKrit, 12).Interior.ColorIndex = 6 Then
varFarbsummeSpalteL = varFarbsummeSpalteL + Cells(iKrit, 12)
End If
If Cells(iKrit, 13).Interior.ColorIndex = 6 Then
varFarbsummeSpalteM = varFarbsummeSpalteM + Cells(iKrit, 13)
End If
If Cells(iKrit, 14).Interior.ColorIndex = 6 Then
varFarbsummeSpalteN = varFarbsummeSpalteN + Cells(iKrit, 14)
End If
If Cells(iKrit, 15).Interior.ColorIndex = 6 Then
varFarbsummeSpalteO = varFarbsummeSpalteO + Cells(iKrit, 15)
End If
End If
Next
Range("D1511") = varMinWerteSpalteI
Range("E1511") = varMinWerteSpalteJ
Range("F1511") = varMinWerteSpalteK
Range("G1511") = varMinWerteSpalteL
Range("H1511") = varMinWerteSpalteM
Range("I1511") = varMinWerteSpalteN
Range("J1511") = varMinWerteSpalteO
Range("I1508") = varFarbsummeSpalteI
Range("J1508") = varFarbsummeSpalteJ
Range("K1508") = varFarbsummeSpalteK
Range("L1508") = varFarbsummeSpalteL
Range("M1508") = varFarbsummeSpalteM
Range("N1508") = varFarbsummeSpalteN
Range("O1508") = varFarbsummeSpalteO
End SubUm wieder die alten Formeln einzutragen erweitere Deine Makros um die Zeilen
Range("I1508").FormulaLocal = "=Farbsumme(I5:I1504;6)"
Range("J1508").FormulaLocal = "=Farbsumme(J5:J1504;6)"
Range("K1508").FormulaLocal = "=Farbsumme(K5:K1504;6)"
Range("L1508").FormulaLocal = "=Farbsumme(L5:L1504;6)"
Range("M1508").FormulaLocal = "=Farbsumme(M5:M1504;6)"
Range("N1508").FormulaLocal = "=Farbsumme(N5:N1504;6)"
Range("O1508").FormulaLocal = "=Farbsumme(O5:O1504;6)"MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 12 von nero022
Danke Oliver !!
eine sache vieleicht noch,wenn es noch möglich ist..?!
die farbsumme die in I1508 endsteht muß noch von D1511 abgezogen werden und bei den anderen auch.
D1511-I1508
E1511-J1508
...
...
muß ich das auch noch in deinem makro einfügen ?!
danke und gruß nero
eine sache vieleicht noch,wenn es noch möglich ist..?!
die farbsumme die in I1508 endsteht muß noch von D1511 abgezogen werden und bei den anderen auch.
D1511-I1508
E1511-J1508
...
...
muß ich das auch noch in deinem makro einfügen ?!
danke und gruß nero
Antwort 13 von coros
Hallo Nero,
wo soll das Ergebnis von dieser Berechnung erscheinen? Oder gibt es diese Berechnung bereits? Wenn ja, wo? Ich habe nämllich nichts gefunden.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
wo soll das Ergebnis von dieser Berechnung erscheinen? Oder gibt es diese Berechnung bereits? Wenn ja, wo? Ich habe nämllich nichts gefunden.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 14 von nero023
hallo oliver,
also die berechnung der farbsumme ist ja in I1508,J1508,K1508,bis O1508.es werden nur die werte berechnet die eingeblendet sind und gelb makiert, oder noch
gelb werden wen sie erledigt sind.
dann müßen sie von der gesamtsumme abgezogen werden.
( berechnung in D1511,E1511,F1511,bis J1511)
z.b / ( gesamtsumme aus I nur was eingeblendet ist - Farbsumme aus I1508 = D1511 )
hoffe du kannst da was mit anfangen wie ich es meine ..!
gruß nero
also die berechnung der farbsumme ist ja in I1508,J1508,K1508,bis O1508.es werden nur die werte berechnet die eingeblendet sind und gelb makiert, oder noch
gelb werden wen sie erledigt sind.
dann müßen sie von der gesamtsumme abgezogen werden.
( berechnung in D1511,E1511,F1511,bis J1511)
z.b / ( gesamtsumme aus I nur was eingeblendet ist - Farbsumme aus I1508 = D1511 )
hoffe du kannst da was mit anfangen wie ich es meine ..!
gruß nero
Antwort 15 von coros
Hallo Nero,
sorry, hatte ich total übersehen, dass in der Formel die Farbsumme noch abgezogen werden muss. Nachfolgendes Makro solte das aber machen.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
sorry, hatte ich total übersehen, dass in der Formel die Farbsumme noch abgezogen werden muss. Nachfolgendes Makro solte das aber machen.
Option Explicit
Sub Filtern()
Dim Datum As Date
Dim iKrit As Integer
Dim iKWNow As Integer
Dim iKWSuch As Integer
Dim varMinWerteSpalteI As Variant
Dim varMinWerteSpalteJ As Variant
Dim varMinWerteSpalteK As Variant
Dim varMinWerteSpalteL As Variant
Dim varMinWerteSpalteM As Variant
Dim varMinWerteSpalteN As Variant
Dim varMinWerteSpalteO As Variant
Dim varFarbsummeSpalteI As Variant
Dim varFarbsummeSpalteJ As Variant
Dim varFarbsummeSpalteK As Variant
Dim varFarbsummeSpalteL As Variant
Dim varFarbsummeSpalteM As Variant
Dim varFarbsummeSpalteN As Variant
Dim varFarbsummeSpalteO As Variant
Application.ScreenUpdating = False
Anfang:
On Error Resume Next
'Eingabe Anzahl der Wochen in der Zukunft
iKWSuch = InputBox("Bitte die Wochenzahl ab heute eintragen," _
& vbLf & vbLf & "Beispiel:" _
& vbLf & "Für übernächste Woche die Zahl 2 eintragen.")
'Wenn EIngabe nicht numersich, Meldung ausgeben
If IsNumeric(iKWSuch) = False Then
MsgBox "Erlaubte Eingabe sind nur Zahlen, Bitte Eingabe wiederholen)"
GoTo Anfang
End If
'Kalenderwoche als Filterkriterium errechnen + Wochenzahl aus Eingabe
iKWNow = DatePart("ww", Now, vbMonday, vbFirstFourDays) + iKWSuch
'Wenn Autofilter aktiv, diesen deaktivieren
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
'Alle Zeilen einblenden
Cells.EntireRow.Hidden = False
'Schleife zum Finden, welche Zelle dem Filterkriterium entspricht. Alle anderen _
Zellen ausblenden
For iKrit = 5 To Range("G1505").End(xlUp).Row
If DatePart("ww", Cells(iKrit, 7), vbMonday, vbFirstFourDays) <> iKWNow Then
Rows(iKrit).EntireRow.Hidden = True
Else
varMinWerteSpalteI = varMinWerteSpalteI + Cells(iKrit, 9)
varMinWerteSpalteJ = varMinWerteSpalteJ + Cells(iKrit, 10)
varMinWerteSpalteK = varMinWerteSpalteK + Cells(iKrit, 11)
varMinWerteSpalteL = varMinWerteSpalteL + Cells(iKrit, 12)
varMinWerteSpalteM = varMinWerteSpalteM + Cells(iKrit, 13)
varMinWerteSpalteN = varMinWerteSpalteN + Cells(iKrit, 14)
varMinWerteSpalteO = varMinWerteSpalteO + Cells(iKrit, 15)
If Cells(iKrit, 9).Interior.ColorIndex = 6 Then
varFarbsummeSpalteI = varFarbsummeSpalteI + Cells(iKrit, 9)
End If
If Cells(iKrit, 10).Interior.ColorIndex = 6 Then
varFarbsummeSpalteJ = varFarbsummeSpalteJ + Cells(iKrit, 10)
End If
If Cells(iKrit, 11).Interior.ColorIndex = 6 Then
varFarbsummeSpalteK = varFarbsummeSpalteK + Cells(iKrit, 11)
End If
If Cells(iKrit, 12).Interior.ColorIndex = 6 Then
varFarbsummeSpalteL = varFarbsummeSpalteL + Cells(iKrit, 12)
End If
If Cells(iKrit, 13).Interior.ColorIndex = 6 Then
varFarbsummeSpalteM = varFarbsummeSpalteM + Cells(iKrit, 13)
End If
If Cells(iKrit, 14).Interior.ColorIndex = 6 Then
varFarbsummeSpalteN = varFarbsummeSpalteN + Cells(iKrit, 14)
End If
If Cells(iKrit, 15).Interior.ColorIndex = 6 Then
varFarbsummeSpalteO = varFarbsummeSpalteO + Cells(iKrit, 15)
End If
End If
Next
Range("D1511") = varMinWerteSpalteI - varFarbsummeSpalteI
Range("E1511") = varMinWerteSpalteJ - varFarbsummeSpalteJ
Range("F1511") = varMinWerteSpalteK - varFarbsummeSpalteK
Range("G1511") = varMinWerteSpalteL - varFarbsummeSpalteL
Range("H1511") = varMinWerteSpalteM - varFarbsummeSpalteM
Range("I1511") = varMinWerteSpalteN - varFarbsummeSpalteN
Range("J1511") = varMinWerteSpalteO - varFarbsummeSpalteO
Range("I1508") = varFarbsummeSpalteI
Range("J1508") = varFarbsummeSpalteJ
Range("K1508") = varFarbsummeSpalteK
Range("L1508") = varFarbsummeSpalteL
Range("M1508") = varFarbsummeSpalteM
Range("N1508") = varFarbsummeSpalteN
Range("O1508") = varFarbsummeSpalteO
End SubMfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.