Herbers Excel-Forum - das Archiv

Wochentage im VBA aufsplitten, aber wie?

Bild

Betrifft: Wochentage im VBA aufsplitten, aber wie?
von: Midgaardslang

Geschrieben am: 08.01.2007 07:47:21
Hallo,
habe noch ein Problem, nachdem mir Bertram hier aus dem Forum so perfekt geholfen hat, nochmals Danke.
Und zwar möchte ich gerne mit VBA Wochentage feststellen, oder generell anfragen wie ein Ansatz dazu aussehen könnte. Ich bräuchte eine Aufteilung in Mo-Do und Fr, und das über das ganze Jahr. Mir wäre es im Extremfall auch nicht zu umständlich, alle Wochen nach R10:R13 und R14 zu sortieren. Leider wüßte ich nur, wie man dies mit einer Formel bewerkstelligen könnte, jedoch nicht wie mit VBA.
Da ich bereits den mir hier gelieferten Ansatz im VBA meinen Bedürfnissen angepasst habe, und idealerweise alle von mir in unterschiedlicher Farbe markierten Tage perfekt auszählen lassen konnte, würde ich dieses Makro gerne vervollständigen und mir die markierten Tage in Mo-Do und Fr aufsplitten, um diese Daten dann weiterzuverwenden.
Über jede Form von Hilfe bin ich natürlich sehr dankbar...
Bild

Betrifft: AW: Wochentage im VBA aufsplitten, aber wie?
von: Heiko S.

Geschrieben am: 08.01.2007 07:58:00
Hallo ???,
du sprichst in Rätsel und lange im Archiv zu suchen was du denn mal für einen Code von Bertram bekommen hast, willst du uns doch nicht wirklich zumuten. !!!
Aus einem Datum den Wochentag zu bekommen geht grundsätzlich mit der WeekDay Funktion:
Sub TestT()
MsgBox Weekday(CDate("08.01.07"))
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
Bild

Betrifft: AW: Wochentage im VBA aufsplitten, aber wie?
von: Midgaardslang

Geschrieben am: 08.01.2007 08:05:56
Bertram hat mir nur einen guten Code gegeben mit Integer Funktion gegeben, der die Anzahl Zellen zählt, die in verschiedenen Farben markiert sind.
Habe leider kein Datumsangabe integriert, daher wär es mir auch recht, im VBA alle Mo-Do als bsp R10:R13 und alle Freitage als R14 einzutragen, und dann diese sortieren zu lassen.
Beispiel 2 Freitag sind rot markiert, 4 "rote" Tage an anderen Werktagen, im Endeffekt möchte ich in einer Zelle 2, in der anderen 4 stehen haben.
Hier nochmal mein angepasster Code:
Sub TageAuszählen()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("A1:M140").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("P20").Value = intGrün
Range("P21").Value = intRot
Range("P22").Value = intGelb
Range("P23").Value = intGrau
Range("P24").Value = intRosa
End Sub

Bild

Betrifft: Noch offen !!!
von: Heiko S.
Geschrieben am: 08.01.2007 08:18:49
Hallo ???
das ist mir zu kompliziert, ich bin raus !!!
Frage also noch offen für weitere Vorschläge !!!
Gruß Heiko
Bild

Betrifft: AW: Noch offen !!!
von: Midgaardslang
Geschrieben am: 08.01.2007 08:20:45
Kein Problem,
bin gerade selber nach Drübergucken über eine mögliche Lösung gestolpert, wenns geklappt hat, poste ich das Ergebnis hier.
Bild

Betrifft: AW: Noch offen !!!
von: Midgaardslang

Geschrieben am: 08.01.2007 08:27:50
Hallo,
habe es jetzt so gelöst, dachte nicht das es geht, bin wie gesagt leider VBA-n00bie.
For Each zelle In Range("D8:D11,F8:F11,H8:H11,J8:J11,L8:L11,usw.").Cells
Einziges Problem, das ich jetzt noch habe, wie kann ich mir an zeigen lassen, das er
D8:D11,F8:F11,H8:H11 usw in Zelle A
und D12,F12,H12 ind Zelle B zählt, wenn man von dem vorher geposteten Code ausgeht?
Danke
Bild

Betrifft: AW: Noch offen !!!
von: Bertram
Geschrieben am: 08.01.2007 08:55:38
Guten Morgen,
am Einfachsten wäre es wohl, wenn du mal deine (abgespeckte) Datei hochlädst und dort reinschreibst was wohin gezählt werden soll.
Gruß
Bertram
Bild

Betrifft: AW: Noch offen !!!
von: Franc

Geschrieben am: 08.01.2007 09:11:33
Denk auch das es das beste ist wenn du die Datei hochlädst. Ich habe auch net soviel Ahnung aber der Code den du gepostet hast, ist doch sehr einfach zu verstehen.
Zu deiner Frage
Erst werden die Variablen festgelegt und hier wird auch gleich gesagt was die Variablen enthalten sollten. Integer heisst in dem Fall, das die Variable eine Zahl von -32768 bis 32767 enthalten darf.
Mit den nächsten Zeilen wird geprüft welche Farbe die Zelle hat und je nachdem die entsprechende Variable hochgezählt.
Zum Schluß noch den Ausgabeort angeben.
In deinem Fall würde das dann so aussehen wobei x für den Namen deiner Variablen steht.
[A1] = x
PS: Das man jeden Bereich angibt wo ein entsprechender Wochentag auftaucht, ist umständlich.
Bild

Betrifft: AW: Noch offen !!!
von: Midgaardslang

Geschrieben am: 08.01.2007 10:33:00
Hallo,
habe es soweit doch allein geschafft, und nach 1 2 Problemen am Anfang läuft es sogar.
Hätte jetzt ein anderes, da ich den Code mal unten anfüge.
Kann ich ein Makro erstellen, das alle anderen ausführt, ohne das ich jedesmal alle aufrufen muss? Code is unten dran, Datei kann ich leider nicht hochladen, diese ist um die 4500 KByte groß. Außerdem will ich ja auch was Lernen, um nicht in 10 Tagen das gleiche zu fragen und nicht euch alle Arbeit machen lassen. Ich bin ja schon für deine geleistete Hilfe sehr dankbar @Bertram.
Sub TageAuszählenMoDoFrühjahr()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D8:L11,D19:L22,D30:J33").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("P20").Value = intGrün
Range("P21").Value = intRot
Range("P22").Value = intGelb
Range("P23").Value = intGrau
Range("P24").Value = intRosa
End Sub

Sub TageAuszählenMoDoSommer()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("L30:33,D42:L45,D53:L56,D64:L67,D76:L79,D87:L90,D98:L101").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("T20").Value = intGrün
Range("T21").Value = intRot
Range("T22").Value = intGelb
Range("T23").Value = intGrau
Range("T24").Value = intRosa
End Sub

Sub TageAuszählenMoDoWinter()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D110:L113,D121:L124,D132:N135").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("X20").Value = intGrün
Range("X21").Value = intRot
Range("X22").Value = intGelb
Range("X23").Value = intGrau
Range("X24").Value = intRosa
End Sub

Sub TageAuszählenFrFrühjahr()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D12:L12,D23:L23,D34:J34").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("Q20").Value = intGrün
Range("Q21").Value = intRot
Range("Q22").Value = intGelb
Range("Q23").Value = intGrau
Range("Q24").Value = intRosa
End Sub

Sub TageAuszählenFrSommer()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("L34,D46:L46,D57:L57,D68:L68,D80:L80,D91:L91,D102:L102").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("U20").Value = intGrün
Range("U21").Value = intRot
Range("U22").Value = intGelb
Range("U23").Value = intGrau
Range("U24").Value = intRosa
End Sub

Sub TageAuszählenFrWinter()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D114:L114,D125:L125,D136:N136").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("Y20").Value = intGrün
Range("Y21").Value = intRot
Range("Y22").Value = intGelb
Range("Y23").Value = intGrau
Range("Y24").Value = intRosa
End Sub

Bild

Betrifft: AW: Noch offen !!!
von: Bertram

Geschrieben am: 08.01.2007 10:59:20
Hi,
im Prinzip kanst du ein Makro schreiben, das dir alle nacheinander ausführt:
Sub Alle()
Call MoDoFrühjahr
Call MoDoSommer
etc.
End Sub

Das ist allerdings sehr unschön, da sich ja nur die Bereiche ändern, ansonsten der Code aber gleich ist. Besser du vergibst für deine Bereich Namen und sprichst diese dann im Code an. Folgender Code ist zwar auch nicht das Highlight der Programmierkunst, sollte aber funktionieren, wenn du die entsprechenden Namen vergibst.
Sub TageAuszählenMoDoFrühjahr()
Dim i As Integer
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
Dim ArrBereiche(1 To 6) As String
Dim ArrErg(1 To 6) As Integer
ArrBereiche(1) = "MoDoFrühjahr"
ArrBereiche(2) = "MoDoSommer"
ArrBereiche(3) = "MoDoWinter"
ArrBereiche(4) = "FrFrühjahr"
ArrBereiche(5) = "FrSommer"
ArrBereiche(6) = "FrWinter"
ArrErg(1) = "P"
ArrErg(2) = "T"
ArrErg(3) = "X"
ArrErg(4) = "Q"
ArrErg(5) = "U"
ArrErg(6) = "Y"
For i = 1 To 6
For Each zelle In Range(ArrBereiche(i)).Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range(ArrErg(i) & "20").Value = intGrün
Range(ArrErg(i) & "21").Value = intRot
Range(ArrErg(i) & "22").Value = intGelb
Range(ArrErg(i) & "23").Value = intGrau
Range(ArrErg(i) & "24").Value = intRosa
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
Next i
End Sub

Hab den Code nicht getestet, sollte aber funktionieren:-)
Gruß
Bertram
Bild

Betrifft: AW: Noch offen !!!
von: Midgaardslang

Geschrieben am: 08.01.2007 11:09:16
Tja, ich kann Dir wie immer nur danken.
Habe leider nur Erfahrungen mit den "Excel-Formelbefehlen" und im Grunde gar keine mit VBA, daher siehts auch so schlecht aus. Ich würde gerne noch einmal darauf zurückkommen und Dich vielleicht noch einmal auf den Code ansprechen wollen, da meine VBA-Künste im Grunde nicht vorhanden sind, und ich die meisten Befehle und Scripte nur aus Erfahrung (wie z.b. Integer, Strukturen, usw.) mit anderen Programmiersprachen (paar Jahre Delphi & VisualC in der Schule) deuten kann.
Die sind aber schon ordentlich angerostet, und ich verstehe eben auch gerne, was ich schreibe, um es bei Bedarf später anzupassen :-) oder zu korrigieren. Vielleicht kannst Du mir dann das eine oder andere erklären nachdem ich mich in nem Kurztutorial darüber schlau gemacht habe - mit Arr*** kann ich spontan z.b. wenig anfangen.
Und wiederum ein Danke...Du bist einfach eine extrem kompetente Hilfe.
Bild

Betrifft: AW: Noch offen !!!
von: Bertram

Geschrieben am: 08.01.2007 11:20:13
Erst mal ne kleine Korrektur:
Statt
Dim ArrErg(1 To 6) As Integer
muss es heißen
Dim ArrErg(1 To 6) As String
Zur Erklärung:
Alles was hinter den DIMs steht sind Variablennamen, d.h. die kannst du auch "Hinz" und "Kunz" nennen. DAmit aber das ganze übersictlich bleibt, solltest du namen vergeben, die dir auch ungefähr sagen, wozu sie gut sind.
"intGelb" ist als Integer deklariert und soll die gelben Zellen zählen (könnte aber auch "ZählGelb" oder sonstwie heißen.
"ArrBereiche" zeigt mir nur, dass es sich bei der Variablen um ein Feld (Array) handelt (hier mit 6 Einträgen).
Die Namen "MoDoFrühjahr" usw. weist du im Tabelenblatt direkt zu, indem du die entsprechenden Zellen markierst und in dem Kasten links oben (dort, wo sonst der Zellname z.B. A1) den Namen reinschreibst oder über
Einfügen, Namen, Definieren...
Der Code an sich macht im Prinzip immer noch das gleiche wie vorher. Mit der Schleife
For i = 1 to 6
usw.
durchläufst du alle Bereiche, die du davor definiert hast und du musst nicht 6 Makros für die selbe Sache schreiben.
Falls du noch Fragen hast meld dich einfach.
Gruß
Bertram
Bild

Betrifft: AW: Noch offen !!!
von: Midgaardslang

Geschrieben am: 08.01.2007 11:45:36
Und wieder Danke.
Wenn Du mir es schon anbietest, eine Frage hätte ich doch noch, die aber nichts damit zu tun hat.
Kann ich meine fertigen Tabellenblätter auch schützen, da ich sehr viele Formeln abseits dieses Scriptes eingebaut und geschrieben habe (Verhältnis Eingabefelder/Formelfelder 30/70), aber dem Benutzer es nur ermöglichen möchte, Werte in bestimmte Bereiche einzutragen, so dass dieser mir auf keinen Fall etwas daran verändern kann. Leider ist dieses Dokument auch für einige, naja, Datentypisten vorgesehen, die stur und dämlich über alles drüber schreiben und mit Müh und Not Excel beherrschen. Wenn da z.B. #WERT steht, wird eben die ganze Tabelle einfach mit 0 ausgefüllt und überschrieben - der Grund? Damit die "Fehler" vorm Eingeben raus sind, habe das ernsthaft schon des öfteren gehört, auch wenn diese Bereiche mit den Fehlern explizit für andere Bearbeiter gekennzeichnet sind.
Ich habe zwar schon für alle Dummen alle Bereiche farbig unterlegt, die mit Formeln gespickt sind, das interessiert jedoch nur sehr wenige und ich bekomme regelmäßig Tabellen zurück, die zwar korrekt ausgefüllt, jedoch fast komplett formelbereinigt sind.
Könnte ich also auf dem Tabellenblatt bestimmte Bereiche "sperren" oder ist das nur ein Wunschtraum :-) ?
Bild

Betrifft: AW: Noch offen !!!
von: Midgaardslang

Geschrieben am: 08.01.2007 12:14:26
Ich eröffne dazu mal einen neuen Thread, damit auch andere was davon haben
 Bild
Excel-Beispiele zum Thema "Wochentage im VBA aufsplitten, aber wie?"
Wochentage Mo - Fr in Tabelle eintragen Anzahl eines bestimmten Wochentages im Monat
Alle Werte eines Wochentages aus Monatsblättern addieren Werte eines bestimmten Wochentages und eines Zeitbereiches addieren
Anzahl der Wochentage in einem vorgegebenen Zeitraum ermitteln Varianten zur Ermittlung des Wochentages eines Datums
Nach Wochentagen summieren Bestimmte Wochentage ohne Feiertage listen