Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 09:08:00
Export alle Tabellenblätter als csv - in bestimmten Ordner
26.04.2024 08:56:40
Über alle Spalten nur €-Werte zählen
26.04.2024 08:08:24
Pivot Vormonatsveränderung
26.04.2024 07:54:11
nur den ersten Eintrag in spalte zählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1856to1860
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1856to1860
1856to1860
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Feiertage übertragen per Makro

Feiertage übertragen per Makro
29.11.2021 18:45:31
MaBlu
Hallo zusammen
kann mir jemand behilflich sein bei meinem Ferienkalender?
Ich habe ihn erstellt was noch fehlt sind die Feiertage und die Kalenderwochen einzutragen wenn das Jahr wechselt.
Mit den Feiertagen klappt es teilweise, aber nicht korrekt und ich komme nicht auf die Lösung weil meine Kenntnisse von Makros zu gering ist!
Hier meine Datei: https://www.herber.de/bbs/user/149469.xlsm
Die Feiertage sollten im Kalender in die Spalte D,H,L usw. eingetragen werden.
Die Kalenderwochen am liebsten Transparent vor das Datum/Wochentag, wenn das nicht möglich ist in die Spalten E,I,M usw. Da habe ich leider keine Lösung gefunden?
Vielen Dank im Voraus, es würde mich freuen wenn sich jemand meinem Problem annimt.
Freundliche Grüsse MaBlu

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Feiertage übertragen per Makro
29.11.2021 19:55:54
ralf_b
Hallo,
was hat dich denn bewogen so ein Projekt zu beginnen wen du dich mit dem Progammieren nicht wirklich auskennst?
Ich frage aus reinem Interesse. Denn solche Jahresplaner gibt es doch schon mit wenigen Klicks frei verfügbar im Netz. z.b. bei Schulferien.org
gruß
rb
AW: Feiertage übertragen per Makro
29.11.2021 20:04:21
MaBlu
Hallo Danke für die Frage
eventuell kann man ja auch so noch was dazulernen!
Gruss MaBlu
AW: Feiertage übertragen per Makro
29.11.2021 20:02:51
Piet
Hallo
ich habe mir erlaubt den Code ein klein bisschen umzuschreiben. Habe für Kalender eine durchgehende With Klammer gesetzt. Er war fast perfekt!
Den eigentlichen Fehlerfindest du in deinem Code an dieser Stelle - For lloRow = 4 To 30 - dort steht bei dir von 4 To 24
mfg Piet
  • 
Sub sbHolidays()
Dim lloCol As Long, lloRow As Long, lloKal As Long, lloStart As Long, lloEnd As Long
Dim liPos As Integer, FTG As Worksheet  'Feiertage
With Worksheets("Kalender")
For lloCol = 4 To 24 Step 4
With Range(Cells(7, lloCol), Cells(37, lloCol))
.Value = ""
.Font.ColorIndex = xlAutomatic
.Font.ColorIndex = 1 'Farbe 1= schwarz, 3= Rot
.Font.Name = "Arial" 'Schriftart
.Font.Size = 8 'Schriftgrösse
.Font.Bold = False 'nicht Fett
.Font.Italic = False 'nicht Kursiv
.Font.Underline = xlUnderlineStyleNone 'kein Unterstrich
.Interior.Pattern = xlNone 'kein Muster
.Interior.ColorIndex = xlNone 'bringt den Hintergrund ohne Farbe!
End With
With Range(Cells(41, lloCol), Cells(71, lloCol))
.Value = ""
.Font.ColorIndex = xlAutomatic
.Font.ColorIndex = 1 'Farbe 1= schwarz, 3= Rot
.Font.Name = "Arial" 'Schriftart
.Font.Size = 8 'Schriftgrösse
.Font.Bold = False 'nicht Fett
.Font.Italic = False 'nicht Kursiv
.Font.Underline = xlUnderlineStyleNone 'kein Unterstrich
.Interior.Pattern = xlNone 'kein Muster
.Interior.ColorIndex = xlNone 'bringt den Hintergrund ohne Farbe!
End With
Next
Set FTG = Sheets("Feiertage")
For lloRow = 4 To 30
Select Case Month(FTG.Range("C" & lloRow))
Case Is

    • Anzeige
    AW: Feiertage übertragen per Makro
    29.11.2021 20:29:01
    MaBlu
    Hallo Piet
    vielen Dank, jetzt klappts, ich wusste es war ein kleiner Fehler aber ja jetzt wenn ichs sehe klar!!
    Hast due eventuell noch eine Idee für die Kalenderwochen?
    Aber vielen Dank für die Hilfe
    Gruss MaBlu
    AW: Feiertage übertragen per Makro
    29.11.2021 22:29:53
    Piet
    Hallo MaBlu
    ich weiss im Augenblick nicht was du damit konkret meinst? Ich denke die sind doch korrekt ausgefüllt? Habe aber nicht darauf geachtet.
    mfg Piet
    AW: Feiertage übertragen per Makro
    29.11.2021 23:58:59
    MaBlu
    Hallo Piet
    ich probiers mal zu erklären ich möchte noch zusätzlich die Kalenderwochen anzeigen zB. KW 01, KW02 usw
    dazu habe ich eine Formel gefunden:

    wenn ich diese in die Zelle gebe kann ich keinen Text mer hineinschreiben!
    Und wenn ich das Jahr wechsle müsste ja auch die KW den Tag ändern das tut es aber mit dieser Formel nicht, da denke ich dass man das mit einem Makro machen sollte aber wie?
    Userbild
    ungefähr so, abr so dass ich in dieser Zelle Text eingeben kann.
    Ich hoffe man versteht das, war jetzt schon schwierig zu erklären geschweige denn die Lösung?
    Gruss MaBlu
    Anzeige
    AW: Feiertage übertragen per Makro
    30.11.2021 00:10:42
    MaBlu
    Hier noch ein gefundenes Makro das man umschreiben müsste!
    For Each Zelle In Range("B2:B32,B35:B65,E2:E30,E35:E65,H2:H32,H35:H64,K2:K31,K35:K65,N2:N32,N35:N64,Q2:Q31,Q35:Q65")
    If Zelle.Value = "Mo" Then
    If Zelle.Offset(0, 1).Value = "" Then
    Zelle.Offset(0, 1).Value = "KW" & _
    DINKW(Format(Zelle.Offset(-Zelle.Offset(0, -1).Value, -1).Value + _
    Zelle.Offset(0, -1).Value - 1, "dd.mm.yyyy"))
    Else
    Zelle.Offset(0, 1).Value = Zelle.Offset(0, 1).Value & ", KW" & _
    DINKW(Format(Zelle.Offset(-Zelle.Offset(0, -1).Value, -1).Value + _
    Zelle.Offset(0, -1).Value - 1, "dd.mm.yyyy"))
    End If
    Zelle.Offset(0, 1).Characters(Start:=InStr(1, Zelle.Offset(0, 1).Value, "KW") - 2, Length:=6).Font.ColorIndex = 0
    End If
    Next>
    sieht so aus:
    Userbild
    Gruss MaBlu
    Anzeige
    AW: Feiertage übertragen per Makro
    30.11.2021 11:05:52
    Piet
    Hallo Mablu
    ich bin nicht jeden Tag im Forum, meine Antwort kann schon mal 2-3 Tage dauern. Da hast du mir eine harte Nuss zum knacken gegeben!
    Das Programm läuft mit dem Code, AUSSER wenn der Feiertag auf einen Montag fällt. Dort versagt das Makro leider!!
    Ich habe versucht die KW als Text anzuhängen, aber dann zählt er mir irrationale KW's in den Feiertagen auf. Alle Versuche das mit dem Befehl If Instr(Cells(), "KW") abzufangen sind fehlgeschlagen. Ich habe keine Ahnung warum, in dem Fall der Befehl wird einfach ignoriert!! Egal mit welcher Variante!
    Nun ja, bis auf die Feiertage die du dann leider von Hand korrigieren musst funktioniert es ja. Aber warum in deinem Code der IF Befehl versagt ist mir ein Rätsel!!!
    mfg Piet
  • 
Sub sbHolidays()
Dim lloCol As Long, lloRow As Long, lloKal As Long, lloStart As Long, lloEnd As Long
Dim liPos As Integer, KW As Integer, Txt As String, FTG As Worksheet  'Feiertage
With Worksheets("Kalender")
For lloCol = 4 To 24 Step 4
With Range(Cells(7, lloCol), Cells(37, lloCol))
.Value = ""
.Font.ColorIndex = xlAutomatic
.Font.ColorIndex = 1 'Farbe 1= schwarz, 3= Rot
.Font.Name = "Arial" 'Schriftart
.Font.Size = 8 'Schriftgrösse
.Font.Bold = False 'nicht Fett
.Font.Italic = False 'nicht Kursiv
.Font.Underline = xlUnderlineStyleNone 'kein Unterstrich
.Interior.Pattern = xlNone 'kein Muster
.Interior.ColorIndex = xlNone 'bringt den Hintergrund ohne Farbe!
End With
With Range(Cells(41, lloCol), Cells(71, lloCol))
.Value = ""
.Font.ColorIndex = xlAutomatic
.Font.ColorIndex = 1 'Farbe 1= schwarz, 3= Rot
.Font.Name = "Arial" 'Schriftart
.Font.Size = 8 'Schriftgrösse
.Font.Bold = False 'nicht Fett
.Font.Italic = False 'nicht Kursiv
.Font.Underline = xlUnderlineStyleNone 'kein Unterstrich
.Interior.Pattern = xlNone 'kein Muster
.Interior.ColorIndex = xlNone 'bringt den Hintergrund ohne Farbe!
End With
Next
Set FTG = Sheets("Feiertage")
For lloRow = 4 To 30
Select Case Month(FTG.Range("C" & lloRow))
Case Is

    • Anzeige
    AW: @Piet
    30.11.2021 11:43:53
    hary
    Moin Piet
    Nur aus Neugierde mitgelesen.
    So?
    
If .Cells(lloKal, lloCol).Value = FTG.Range("C" & lloRow) Then
.Cells(lloKal, lloCol + 2) = .Cells(lloKal, lloCol + 2) & " " & FTG.Range("B" & lloRow) '--Aenderung
.Cells(lloKal, lloCol + 2).Font.ColorIndex = 3
.Cells(lloKal, lloCol + 2).Font.Bold = True
End If
    gruss hary
    AW: @Piet
    30.11.2021 13:01:57
    MaBlu
    Hallo Hary
    Vielen Dank für deine Hilfe, Piet hat mir die Vorlage geschaffen und du hast den Rest gemacht ich konnte die beiden Versionen zusammengebaut, damit klappt das mit den KWs leider ist dann die Schriftfarbe im ganzen Text gleich? Wenn ich da noch einen Vorschlag bekomme dann ist das Gelöst!
    Ich bedanke mich aber jetzt schon herzlich das hat Spass gemacht mit euch!
    Gruss MaBlu
    Anzeige
    AW: Feiertage übertragen per Makro
    30.11.2021 12:59:55
    MaBlu
    Hallo Piet
    Vielen Dank für deine Hilfe, Hary hat noch eine änderung vorgeschlagen, damit klappt das mit den KWs leider ist dann die Schriftfarbe im ganzen Text gleich
    wenn ich da noch einen Vorschlag bekomme dann ist das Gelöst!
    Ich bedanke mich aber jetzt schon herzlich das hat Spass gemacht mit euch!
    Gruss MaBlu
    AW: KW in Schwarz
    30.11.2021 13:11:18
    hary
    Moin
    
If .Cells(lloKal, lloCol).Value = FTG.Range("C" & lloRow) Then
.Cells(lloKal, lloCol + 2) = .Cells(lloKal, lloCol + 2) & " " & FTG.Range("B" & lloRow) '--Aenderung
.Cells(lloKal, lloCol + 2).Font.ColorIndex = 3
If Left(.Cells(lloKal, lloCol + 2), 2) = "KW" Then .Cells(lloKal, lloCol + 2).Characters(Start:=1, Length:=5).Font.ColorIndex = xlAutomatic '--KW in Schwarz
.Cells(lloKal, lloCol + 2).Font.Bold = True
End If
    gruss hary
    Anzeige
    gelöst!
    30.11.2021 13:41:49
    MaBlu
    Viele Dank für eure Hilfe
    Grüsse MaBlu
    AW: @ hary Danke für die Hilfe
    30.11.2021 22:55:24
    Piet
    Hallo hary
    ich freue mich das durch deine Hilfe der Thread beendet werden konnte. Schöne Zusammenarbeit, gefällt mir.
    mfg Piet
    AW: sehe ich auch so. Kein problem gruss owT
    01.12.2021 07:11:19
    hary
    .

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige