Excel Tool mit VBA zerschossen, kann das wer fixen?
Hoi zusammen,
ich habe mithilfe der GF Community vor langer Zeit ein Tool gebastelt, das mir helfen soll meine Baustelleneinsätze zu überschauen. Die Idee ist simpel, ne exceltabelle, in der ich zu jedem Tag den entsprechenden Projektnamen notiere und dazu einen durch VBA generierten Kalender. In dem Kalender werden nun zusammenhängende Projekttage durch einheitliche Farben dargestellt. Sprich, ich bin eine Woche in Timbuktu, dann wird diese eine Woche im Kalender Blau markiert, mit dem Namen Timbuktu. Das nächste Projekt erhält eine andere Farbe. Das ganze sieht dann so aus
Das ganze hat auch super funktioniert, aber nun auf einmal nicht mehr. Und ich habe keine Änderungen vorgenommen (kann mir das nicht erklären, bin aber auch kein VBA/Excel Experte) Selbst meine alte Datei von 2023 funktioniert auf einmal nicht mehr, und die lag als Backup irgendwo rum, die hilft dementsprechend auch nicht, das selber zu fixen.
Das nervt mich, weil da nen haufen arbeit drinsteckt, kann mir da wer helfen, im besten Fall selber über den Code schauen? Mit "ja, den string xy in array abc musst du mitm object als integer parametrieren" hilft mir nicht😅
Quelltext is zu lang, ich versuche den als separate Nachricht zu posten oder schicke den gerne per PM/Mail/Brieftaube
Danke und bis denn dann, Gruß Stroiner
Hallo stroiner123,
Du kannst Deine Frage auch nachträglich noch ergänzen - einfach über die drei grauen Punkten auf “Frage bearbeiten”. Je genauer Du Dein Problem beschreibst, desto bessere Antworten wirst Du bekommen.
Viele Grüße
3 Antworten
Klingt ein bisschen altklug, aber ich empfehle dir, Debugtechniken anzueignen. Das ist vergleichbar mit dem Spruch "Du musst nicht alles wissen. Es reicht, zu wissen, wo man es findet".
Zudem empfehle ich dir, zu versuchen, ein Problem möglichst genau zu beschreiben. Wenn du weißt, was dein Problem ist, kannst du es besser lösen, als wenn du bei "geht nicht" aufgibst.
Was geht nicht? Wie weit kommt der Algorithmus? Welche Daten verarbeitet er zu diesem Zeitpunkt? Was sind die genauen Unterschiede zwischen Sollzustand und Istzustand? Funktioniert ein einfaches Hallo-Welt-Script? ...
Super! Genau das meine ich. Du bist schon ziemlich weit zum Kern des Problems vorgedrungen.
Interessant wäre, ob sich das Datum in Excel als Text darstellt oder dahinter eine Zahl steht. Formatiere die Datumszelle mal direkt in Excel als Zahl. Wenn er das schafft, solltest du auf DateValue zugreifen können.
Wenn nicht, musst du mühsam das Datum zu Fuß umwandeln. Zum Umwandeln könntest du dir eine VBA-Funktion basteln, wenn du eh schon mit VBA unterwegs bist. Dann könntest du mit Date(Jahr,Monat,Tag) den Datumswert aus dem Text extrahieren.
Nach ewigen hin und herbasteln, hab ich die Lösung ... simpel wie auch blöd. Ich habe im System das Datumsformat umgestellt und es geht, was nicht verwunderlich ist, da ja ursprünglich am code nichts geändert wurde. Auf diese glorreiche Idee zu kommen hat mich auch nur 4 Stunden gekostet 😂😂
Dennoch vielen Dank an euch, eure Ideen haben mich zumindest motiviert mich eingehend damit zu befassen und erst die erfolgreiche Fehlersuche hat mich auf das Ding mit dem Format geführt, auch wenn die Lösung schlussendlich nicht bei Excel lag.
Danke an alle ... außer Microsoft🙄
Ich stimme dir zu, das war frustbedingte Maulfaulheit. Hab mal meine alten Debuggehirnareale reaktiviert. Also im Einzelschritt scheitert das ganze ding an einem laufzeitfehler 1004, die Variable Zaehler geht hoch bis 6 und im nächsten Durchlauf steht in der Überwachung <außerhalb des kontextes> was immer das bedeutet... ich google und bleibe dran... vielleicht ist irgendwer schneller und hat nen tip.
Wenn es ohne Änderungen einfach nicht mehr geht, und auch das Backup nicht, wird es nicht direkt am Code liegen.
Entweder wird nach einem Update VBA blockiert, oder du hast es irgendwie selbst deaktiviert. In den Exceloptionen kann man sperren/freigeben, ob VBA ausgeführt wird, oder man zumindest vorher freigeben muss. Dann erscheint ein Balken über der Tabelle, ob man das zulassen will.
Ja, das stimmt, aber Makros sind zugelassen, "Inhalt aktivieren" hab ich gedrückt. Der Code wurde schon mit Excel 365 erstellt, welches ich (natürlich geupdated) heute noch nutze. Basiskenntisse hab ich schon, da am Code nichts geändert wurde, gebe ich dir einerseits recht. Aber ich weiß auch, das sich Programmiersprachen weiterentwickeln, Befehle kommen dazu oder verschwinden, usw. Weiß nicht ob das hier auch der Fall ist, kanns mir nach wie vor nicht erklären. Im besten Fall setz ich irgendwo in den Optionen nen Haken und es läuft wieder .... aber wo finde ich den ? 😬
achso, und der code wird ausgeführt, aber fehlerhaft, also kann es nicht sein, das VBA blockiert wird.
Bislang ist in Excel nichts verschwunden. Du müsstest sogar noch die alten Excel 4.0 Makros (Strg+F11) ausführen können.
hi,
du kannst gerne hier den code posten, ich gucke mal rein und siehe ob ich was finde. kann aber nichts versprechen. aber ich weiss, wie frustrierend sowas ist.
hier gehts weiter (3/3) ...
If Szelle.Row = EZelle.Row Then
'kein Monatsübergang im Projekt
With Kalender.Range(Szelle, EZelle)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
'festlegung der farbe
If (Nam = "Urlaub" Or Nam = "Urlaub WE") Then
.Interior.Color = Farbe_spezial(0)
ElseIf (Nam = "Homeoffice") Then
.Interior.Color = Farbe_spezial(1)
ElseIf (Nam = "Krank") Then
.Interior.Color = Farbe_spezial(2)
Else
.Interior.Color = Farbe(f)
End If
'festlegung der farbe
End With
'Kalender.Range(szellemezelle).Color = Farbe(f)
Else
'Monatsübergang im Projekt
'Startdatum bis Monatende
Set DZelle = Szelle.Offset(0, Day(DateValue("1." & Month(SDatum) + 1) - 1) - Day(SDatum))
With Kalender.Range(Szelle, DZelle)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
If (Nam = "Urlaub") Then
.Interior.Color = Farbe_spezial(0)
ElseIf (Nam = "Homeoffice") Then
.Interior.Color = Farbe_spezial(1)
ElseIf (Nam = "Krank") Then
.Interior.Color = Farbe_spezial(2)
Else
.Interior.Color = Farbe(f)
End If
End With
'Zwischenmonate
z = 0
Do Until Month(EDatum) - Month(SDatum) - z = 1
Set DZelle = Szelle.Offset(z + 1, 0 - Day(SDatum) + 1)
Set DDZelle = DZelle.Offset(0, Day(DateValue("1." & Month(SDatum) + z + 1) - 1) - 1)
DZelle.Value = Nam
With Kalender.Range(DZelle, DDZelle)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Interior.Color = Farbe(f)
End With
z = z + 1
Loop
'Rest im Endmonat
Set DZelle = EZelle.Offset(0, 0 - Day(EDatum) + 1)
DZelle.Value = Nam
With Kalender.Range(EZelle, DZelle)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Interior.Color = Farbe(f)
End With
End If
Start = False
Set Szelle = Nothing
Set EZelle = Nothing
Nam = ""
If TZelle.Value <> "" Then
'nächster Projekt beginnt direkt nach Abschluss des letzten
Nam = TZelle.Value
For Each Zelle In KBer
If KBer.Cells(1, Zelle.Column) = Day(TZelle.Offset(0, -1).Value) And Month("1." & KBer.Cells(Zelle.Row, 1).Value) = Month(TZelle.Offset(0, -1).Value) And Zelle.Row > KBer.Row Then
'Starttag
Set Szelle = Zelle.Offset(KBer.Row - 1, KBer.Column - 1)
Szelle.Value = Nam
SDatum = TZelle.Offset(0, -1).Value
Start = True
Exit For 'zelle Start
End If
Next Zelle
End If
End If
End If
Next TZelle
End Sub
Sub Kalendereintrage()
Dim Start As Boolean
Dim SDatum As Date, EDatum As Date
Dim Farbe(10) As Long, f As Long
Dim Farbe_spezial(2) As Long
Dim d As Long, z As Long
Dim KBer As Range, Zelle As Range, Tabelle As Range, TZelle As Range
Dim Szelle As Range, EZelle As Range, DZelle As Range, DDZelle As Range
Dim Nam As String
Dim Kalender As Worksheet
Dim Datum As Date
Dim Tag As Long, Jahr As Long, Wtag As Long
Dim Monat As String
'Bereiche etc festlegen
Set Kalender = ActiveWorkbook.Sheets("Kalender")
Set KBer = Kalender.Range("A1:AF13") 'Kalenderbereich + je 1 Zeile/Spalte Beschriftung
Set Tabelle = ActiveWorkbook.Sheets("Daten").Range("B1:B2000") 'Namenspalte der Tabelle ohne Überschrift + 1 weitere Leerzeile
Start = False
f = -1
'Farbe(0) = RGB(255, 0, 0)
'Farbe(1) = RGB(0, 255, 0)
'Farbe(2) = RGB(110, 139, 61)
'Farbe(3) = RGB(255, 69, 0)
'Farbe(4) = RGB(151, 255, 255)
'Farbe(5) = RGB(255, 64, 64)
'Farbe(6) = RGB(0, 255, 255)
Farbe(1) = RGB(0, 255, 0) 'Limette
Farbe(3) = RGB(255, 255, 0) 'Gelb
Farbe(4) = RGB(0, 255, 255) 'Cyan
Farbe(5) = RGB(255, 0, 255) 'Magenta
Farbe(6) = RGB(192, 192, 192) 'Silber
Farbe(8) = RGB(128, 0, 0) 'Kastanienbraun
Farbe(9) = RGB(128, 128, 0) 'Olive
Farbe(10) = RGB(0, 128, 0) 'Grün
Farbe(2) = RGB(128, 0, 128) 'Lila
Farbe(0) = RGB(0, 128, 128) 'Blaugrün
Farbe(7) = RGB(0, 0, 128) 'Marine
Farbe_spezial(0) = RGB(255, 0, 0) 'Urlaub -> Rot
Farbe_spezial(1) = RGB(255, 105, 180) 'Homeoffice -> Pink
Farbe_spezial(2) = RGB(255, 165, 0) 'Krank -> Orange
'Kalender resetten
KBer.UnMerge
Jahr = Year(Date)
For Each Zelle In KBer
If Zelle.Column - KBer.Column > 0 And Zelle.Row - KBer.Row > 0 Then
'im Kalenderbereich
Zelle.ClearContents
Tag = KBer.Cells(1, Zelle.Column).Value
Monat = KBer.Cells(Zelle.Row, 1)
If IsDate(Tag & "." & Monat & "." & Jahr) Then
Datum = DateValue(Tag & "." & Monat & "." & Jahr)
Wtag = Application.WorksheetFunction.Weekday(Datum, 2)
If Wtag > 5 Then
'Wochenende
Zelle.Interior.Color = RGB(127, 127, 127)
Else
'kein Wochenende
Zelle.Interior.Pattern = xlNone
End If
Else
'unmögliches Datum
Zelle.Interior.Pattern = xlNone
Zelle.Interior.Color = black
End If
End If
Next Zelle
'Namensspalte durchgehen
For Each TZelle In Tabelle
If TZelle.Value <> Nam Then
If Nam = "" Then
'erster Treffer
Nam = TZelle.Value
For Each Zelle In KBer
If KBer.Cells(1, Zelle.Column) = Day(TZelle.Offset(0, -1).Value) And Month("1." & KBer.Cells(Zelle.Row, 1).Value) = Month(TZelle.Offset(0, -1).Value) And Zelle.Row > KBer.Row Then
'Starttag
Set Szelle = Zelle.Offset(KBer.Row - 1, KBer.Column - 1)
Szelle.Value = Nam
SDatum = TZelle.Offset(0, -1).Value
Start = True
Exit For 'zelle Start
End If
Next Zelle
ElseIf Nam <> "" And Start Then
'Eintrag Ende
For Each Zelle In KBer
If KBer.Cells(1, Zelle.Column) = Day(TZelle.Offset(-1, -1).Value) And Month("1." & KBer.Cells(Zelle.Row, 1).Value) = Month(TZelle.Offset(-1, -1).Value) And Zelle.Row > KBer.Row Then
'Endtag
Set EZelle = Zelle.Offset(KBer.Row - 1, KBer.Column - 1)
EDatum = TZelle.Offset(-1, -1).Value
f = (f + 1) Mod (UBound(Farbe) + 1)
Exit For 'zelle Ende
End If
Next Zelle
.... diesen Block musste ich teilen
Zuuuuu lang, aber hier ist der erste Block, um den Kalender zu resetten, der wird entsprechend des Kalenderjahres generiert. Muss quasi oben inner Ecke nur das aktuelle Jahr eintragen und er markiert mir Wochenenden, Schaltjahr, usw.
Sub Kalenderreset()
Dim Datum As Date
Dim Tag As Long, Jahr As Long, Wtag As Long
Dim Ber As Range, Zelle As Range
Dim Monat As String
Dim zaehler As Integer
zaehler = 1
If Cells(1, 1).Value = "" Then
Cells(1, 1).Value = InputBox("Jahr eingeben!")
End If
While (zaehler < 32)
Cells(1, zaehler + 1).Value = zaehler
zaehler = zaehler + 1
Wend
Range("A1:AF13").Interior.Color = RGB(255, 255, 255)
Range("A1:AF13").Borders.LineStyle = xlContinuous
Range("A1:AF13").Borders.Weight = xlThin
Range("A1:AF13").Borders.Color = RGB(0, 0, 0)
Range("A1:A1").BorderAround _
ColorIndex:=1, Weight:=xlThick
Range("B2:AF13").BorderAround _
ColorIndex:=1, Weight:=xlThick
Range("A1:AF13").BorderAround _
ColorIndex:=1, Weight:=xlThick
Cells(2, 1).Value = "Januar"
Cells(3, 1).Value = "Februar"
Cells(4, 1).Value = "März"
Cells(5, 1).Value = "April"
Cells(6, 1).Value = "Mai"
Cells(7, 1).Value = "Juni"
Cells(8, 1).Value = "Juli"
Cells(9, 1).Value = "August"
Cells(10, 1).Value = "September"
Cells(11, 1).Value = "Oktober"
Cells(12, 1).Value = "November"
Cells(13, 1).Value = "Dezember"
With ActiveWorkbook.Sheets("Kalender")
Set Ber = .Range("A1:AF13")
Ber.UnMerge
Jahr = Ber.Cells(1, 1) - 1
For Each Zelle In Ber
If Zelle.Column - Ber.Column > 0 And Zelle.Row - Ber.Row > 0 Then
'im Kalenderbereich
Zelle.ClearContents
Tag = Ber.Cells(1, Zelle.Column).Value
Monat = Ber.Cells(Zelle.Row, 1)
If IsDate(Tag & "." & Monat & "." & Jahr) Then
Datum = DateValue(Tag & "." & Monat & "." & Jahr)
Wtag = Application.WorksheetFunction.Weekday(Datum, 1)
If Wtag > 5 Then
'Wochenende
Zelle.Interior.Color = RGB(127, 127, 127)
Else
'kein Wochenende
Zelle.Interior.Pattern = xlNone
End If
Else
'unmögliches Datum
Zelle.Interior.Pattern = xlNone
Zelle.Interior.Color = x1None
End If
End If
Next Zelle
End With
End Sub
Ich konnte es weiter eingrenzen, laufzeitfehler ist vorerst behoben, aber er färbt nun alle zellen schwarz, was eigentlich nur bei einem "unmöglichen Datum" der Fall ist, also nem 31.November zum Beispiel
ich glaube, es ist die DateValue Funktion, die arbeitet in meiner Version mit deutschen Namen, mir ist aber schon aufgefallen das meine nun englischsprachige version 01.Januar nicht mehr als ein Datum erkennt :O und die funktion dementsprechend einen falschen wert zurückgibt ....
Sowas blödes, eine programmiersprache sollte sprachenunabhängig funktionieren, ich teste und update hier ... das ist nämlich bisher nur die kalenderresett funktion, zum eigentlichen eintragen bin ich noch garnicht gekommen...