MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 08.03.2018, 22:12   #61
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

sorry das ich mich so lange nicht gemeldet habe aber ich bin die letzten Tage nicht dazu gekommen, was zu machen.
Als aller erstes mal wieder Danke, hab das ganze mal in meine Datei übernommen und bin bisschen am probieren.

Und hab natürlich gleich wieder Fragen

1. Das es die Tabelle vom Aktuellen Monat öffnet ist ne gute Idee von dir gewesen, aber ich fände es besser wenn es weiter die Tabelle öffnet mit der man auch gespeichert hat. Der Grund ist das der Dienstplan immer im Vormonat geschrieben wird.
Hab schon versucht folgende zwei Zeilen auszublenden
Code:

Worksheets("Admin").Activate
Worksheets(monat).Activate
aber da bekomm ich immer eine Fehlermeldung

2. Dann wollte ich noch fragen was ich machen muss das wenn ich zum Beispiel unter Sonstige Dienste etwas ändere, das es nach verlassen der Tabelle Admin sofort Aktiv ist, im Moment muss ich Speichern die Datei schließen und neu öffnen das es erkannt wird.

3. Wie kann ich die Fehleranzeige auch im Sommer in Grundstellung bringen, wenn ich zum Beispiel den Button Dienstplan Einträge löschen betätige, so wie im Winter

4. Im Mai was ja schon Sommer ist, hat die Fehleranzeige noch das Format vom Winter

5. Im Sommer geht der Bereich wo ich die Dienste eintrage schon in Spalte B los nicht wie im Winter in Spalte C somit ist bei der Fehleranzeige die erste Spalte weiß.
Ich könnte sonnst auch zwischen A und B ein Spalte einfügen und diese wieder ausblenden, allerdings müsste ich dann meine Formeln wieder anpassen.

6. Ich hab ja noch den Button, Namen vom Vormonat holen, wenn ich das ausführe kommt auch die Meldung es können nur Einzelne Zellen gelöscht werden. Kann man die Meldung vielleicht auf den Bereich wo die Dienstnummern eingetragen werden beschränken?

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.03.2018, 01:24   #62
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

3. hat sich erledigt, hab ich hinbekommen!

4. hat sich auch erledigt, nach der Aktualisierung war alles wie gewollt!

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.03.2018, 06:12   #63
aloys78
MOF Meister
MOF Meister
Standard

Hallo Miro,

gut zu wissen, das sich Probleme erledigt haben.

Zu Deinem vorherigen Beitrag.
Die Punkte 1, 2 und 6 habe ich verstanden.
Hier sehe ich keine großen Probleme, muß aber noch über eine konkrete Lösung nachdenken.

Aber was erwartest Du bei diesem Punkt konkret

Zitat:

5. Im Sommer geht der Bereich wo ich die Dienste eintrage schon in Spalte B los nicht wie im Winter in Spalte C somit ist bei der Fehleranzeige die erste Spalte weiß.
Ich könnte sonnst auch zwischen A und B ein Spalte einfügen und diese wieder ausblenden, allerdings müsste ich dann meine Formeln wieder anpassen.

Egal was Du machst: in beiden Fällen müßte der Code angepasst werden.
Ich kann im Moment noch nicht sagen, was das bedeutet.

Warum kannst Du im Sommer nicht auch mit Sp C beginnen ?
Die andere Frage, warum Du damit erst jetzt herausrückst, will ich gar nicht erst stellen.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.03.2018, 07:52   #64
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Guten Morgen Aloys,

zu Punkt 5:

der Grund warum ich im Winter in Spalte C beginne ist, Nach einem Rodelabend sollte man Frei haben da dieser am Abend länger geht und sonst die Pause bis zum Dienstbeginn zu kurz ist, das überprüfe ich auch und habe daher den letzten Tag vom Vormonat in Spalte B eingefügt um zu Prüfen ob dieser ein Rodelabend war, diese Spalte habe ich aber ausgeblendet. Da wir im Sommer ja keinen Rodelabend haben entfällt diese Spalte, daher geht es im Sommer mit Spalte B los mit den Einträgen der Dienstnummern.

Wenn es nient so einfach machbar ist, dann füge ich im Sommer einfach auch noch eine leere Spalte ein und blende diese wieder aus, dann muss ich halt alles anpassen.

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.03.2018, 08:17   #65
aloys78
MOF Meister
MOF Meister
Standard

Hallo Mirko,

Zitat:

... dann füge ich im Sommer einfach auch noch eine leere Spalte ein und blende diese wieder aus, dann muss ich halt alles anpassen.

Ohne den Aufwand für die Codeänderung abgeschätzt zu haben, ist dieses Vorgehen m.E. letztlich das Beste.
Es gibt dann nur eine Formel- und VBA-Lösung für Sommer und Winter.

Ich bin heute wieder unterwegs, deswegen wird es mit einem Vorschlag für die anderen Punkte etwas dauern.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.03.2018, 12:23   #66
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

also Punkt 5 hat sich auch erledigt, hab Spalten eingefügt und alles angepasst

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.03.2018, 17:31   #67
aloys78
MOF Meister
MOF Meister
Standard

Hallo Mirko,

Zitat:

also Punkt 5 hat sich auch erledigt

Danke für die Info.

Zum Punkt 6 habe ich noch Fragen:

Was soll möglich sein ?
- löschen eines / mehrerer Namen
- einfügen eines / mehrerer Namen.
- ersetzen von Namen

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.03.2018, 22:43   #68
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

das mit den Namen funktioniert ja schon wunderbar, ich habe folgende Möglichkeiten die ich mit verschiedene Button ausführen kann.

1. Name um eine Position nach oben oder unten verschieben (zwei Button)
2. Name um fünf Positionen nach oben oder unten verschieben (zwei Button)
in beiden fällen wird die ganze Zeile ausgeschnitten und an passender Position wieder eingefügt. So das auch alle Einträge bei dem Namen bleiben

3. Einen Namen löschen (ein Button - UserForm)
da wird nur der Name gelöscht und dann die leere Zeile ausgeschnitten und unterhalb des letzten Namen wieder eingefügt, so das keine leere Zeile zwischen den Namen ist. Der Name kann auf wunsch auch in der Tabelle Mitarbeiter mit gelöscht werden.

4. Name Hinzufügen (ein Button - UserForm)
da wird unterhalb des letzten Namen ein neuer Name hinzugefügt, das passiert mit einem UserForm wo ich den Namen eingeben kann und dann auf Hinzufügen gehe. Dieser Name wird auf wunsch auch in Tabelle Mitarbeiter eingetragen.

5. Alle Namen vom Vormonat holen (ein Button)
da werden alle Namen in gleicher Reihenvolge vom Vormonat rüber kopiert

6. Alle Namen löschen (ein Button)
da werden einfach alle Namen im Bereich A6:A58 gelöscht


Vieleicht kann ich ja mit einem Befehl, werend ich einer dieser Funktionen ausführe die sache mit "man kann nur einzelne Zellen löschen" deaktivieren und danach wieder aktivieren?
Im Bereich A6:A58 hab ich di Entfernen Taste komplett gesperrt, da geht nichts mehr mit Entf.

Mir ist auch aufgefallen das zwar die Meldung kommt das man nur einzelne Zellen löschen kann, wenn mehrere selektiert sind, aber gelöscht wird trotzdem der inhalt von allen Markierten Zellen!

Dann habe ich auch noch eine Button wo ich den kompletten Bereich wo ich die Dienstnummern eingebe löschen kann, da kommt auch die Meldung!

Zitat:

Was soll möglich sein ? ist schon Möglich
- löschen eines / mehrerer Namen Ja, aber immer nur einer
- einfügen eines / mehrerer Namen. Ja, aber immer nur einer
- ersetzen von Namen Nein

Soviel zu Punkt 6

Dann hätte ich noch ne Frage und zwar haben wir ja die Funktion Fehler anzeige in Grundstellung bringen, was ja auch wunderbar Funktioniert!
Jetzt hab ich noch eine Funktion mit eingebaut, wenn man die Jahreszahl ändert kann man auf Wunsch die Datei mit neuer Jahreszahl neu abspeichern und alle Einträge löschen, klappt auch wunderbar, nur bekomme ich es nicht hin das in allen Monaten die Fehleranzeigen in Grundstellung gebracht werden. Hast du mir da vielleicht auch noch einen Tipp wie ich das hinbekommen könnte?!

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 10.03.2018, 04:54   #69
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Guten Morgen Aloys,

mir ist noch was eingefallen, gibt es vielleicht die Möglichkeit das man nur maximal eine Zelle selektieren kann? Das wäre ja perfekt, dann könnten wir uns das mit dem "Es darf nur eine Zelle gelöscht werden" komplett sparen.

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 10.03.2018, 06:14   #70
aloys78
MOF Meister
MOF Meister
Standard

Hallo Mirko,

Vorschlag zu Punkt 1: folgender Code ersetzt den vorhandenen
Code:

Private Sub Workbook_Open()
' Version V7 vo 10.03.2018
'*************************************************************************************
' Beim Öffnen der Datei werden die Arrays aufgebaut und das zuletzt gespeicherte
' Tabellenblatt aktiviert
'*************************************************************************************
    Dim Sh As Worksheet
    Dim monat As String
    monat = ActiveSheet.Name                ' Name des zuletzt gespeicherten Blattes
    Worksheets("Admin").Activate
    Call Array_Aufbau                       ' Arrays für die Monatsblätter aufbauen
    On Error Resume Next
    Worksheets(monat).Activate              ' aktuelles Monatsblatt ansteuern
    On Error GoTo 0
End Sub
Vorschlag zu Punkt 2: folgenden Code unter DieseArbeitsmappe neu einfügen
Code:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
' Version V7 vom 10.03.2018
    If Sh.Name = "Admin" Then Call Array_Aufbau         ' etwaige Änderungen von Diensten sofort berücksichtigen
End Sub
Punkt 6 noch offen: muss ich noch klären
Im Eingabebereich ab Sp C gilt: Dienst kann nur in einer Zelle eingegeben werden; dann wird auf Doppelbelegung geprüft.
Wenn Du eine komplette Zeile einfügst, dann wird eine solche Prüfung auf Doppeleingabe entfallen.

Und dann Dein vorletzter Beitrag:

Zitat:

Dann hätte ich noch ne Frage und zwar haben wir ja die Funktion Fehler anzeige in Grundstellung bringen, was ja auch wunderbar Funktioniert!
Jetzt hab ich noch eine Funktion mit eingebaut, wenn man die Jahreszahl ändert kann man auf Wunsch die Datei mit neuer Jahreszahl neu abspeichern und alle Einträge löschen, klappt auch wunderbar, nur bekomme ich es nicht hin das in allen Monaten die Fehleranzeigen in Grundstellung gebracht werden.

Dann stell mal den aktuellen Code hierfür zur Verfügung.

Und Dein neuester Beitrag:

Zitat:

mir ist noch was eingefallen, gibt es vielleicht die Möglichkeit das man nur maximal eine Zelle selektieren kann?

Sp A und / oder Bereich ab Sp C ?
Für welche Funktionen ?

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 10.03.2018, 07:27   #71
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

als erstes nochmal vielen Dank, ohne dich wäre das alles nicht hab so gut.

Zitat:

Zitat:

mir ist noch was eingefallen, gibt es vielleicht die Möglichkeit das man nur maximal eine Zelle selektieren kann?

Sp A und / oder Bereich ab Sp C ?
Für welche Funktionen ?

Am besten wäre wenn man in Spalte A und ab Spalte C oder besser gleich von Spalte A weg. Eigentlich könnte man das ganze Blatt machen da es nirgends nötig ist mehr als eine Zelle zu selektieren.

Wenn das möglich wäre, könnte man das mit der MsgBox es darf nur eine Zelle gelöscht werden wieder entfernen.

Zitat:

Zitat:

Dann hätte ich noch ne Frage und zwar haben wir ja die Funktion Fehler anzeige in Grundstellung bringen, was ja auch wunderbar Funktioniert!
Jetzt hab ich noch eine Funktion mit eingebaut, wenn man die Jahreszahl ändert kann man auf Wunsch die Datei mit neuer Jahreszahl neu abspeichern und alle Einträge löschen, klappt auch wunderbar, nur bekomme ich es nicht hin das in allen Monaten die Fehleranzeigen in Grundstellung gebracht werden.

Dann stell mal den aktuellen Code hierfür zur Verfügung.

Das kann ich erst heute Abend machen, da ich heut den ganzen Tag unterwegs bin.

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 10.03.2018, 15:51   #72
aloys78
MOF Meister
MOF Meister
Standard

Hallo Mirko,

zunächst eine Korrektur; zu Punkt 2 den nachfolgenden Code statt des vorher übersandten unter DieseArbeitsmappe einfügen.
Code:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
' Version V7.1 vom 10.03.2018
    If Sh.Name = "Admin" Then
        p_swArr = False           ' Arrays müssen neu aufgebaut werden
        Call Array_Aufbau         ' etwaige Änderungen von Diensten sofort berücksichtigen
    End If
End Sub
Vorschlag zum Punkt 6; ebenfalls unter DieseArbeitsmappe einfügen.
Im Eingabebereich ist nur noch die Auswahl einer Zelle möglich.
Code:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
' Version V 7.1 vom 10.03.2018
'========================================================================================================
' Beim Eingabe-Bereich der Monatsblätter darf immer nur eine Zeile ausgewählt werden.
'========================================================================================================

    Dim datum As Date                   ' Datum

    If Target.CountLarge = 1 Then Exit Sub              ' es wurde nur 1 Zelle ausgewählt

'-------------------------------------------------------------------------------------
' Check ob Monats-Tabelle, dann
' - ermittle letzte Spalte des Monatsbereichs,
' - prüfe, ob Auswahl innerhalb Eingabebereich,
' - reduziere Auswahl auf die 1. Zelle des markierten Bereichs
' - Fehlernachricht ausgeben
'-------------------------------------------------------------------------------------
    Select Case Sh.Name                 ' Name des aktuellen tabellenblattes
        Case Is = "Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", _
            "Oktober", "November", "Dezember"
        Case Else
            Exit Sub                        ' kein Monatsblatt
    End Select
    
    datum = Sh.Cells(3, Target.Column)
    nT = Day(DateSerial(Year(datum), Month(datum) + 1, 1) - 1)          ' Anzahl Tage im Monat
    c = 3                           ' Spalte C = Start-Spalte
    c2 = c + nT - 1                 ' letzte Spalte Monatsbereich
    With Sh
        Set UBereich = Union(.Range("A6:A58"), Range(.Cells(6, "C"), .Cells(58, c2)))
        If Intersect(Target, UBereich) Is Nothing Then Exit Sub     ' mehrere Zellen ausgewählt, aber außerhalb Eingabebereich
    End With
    
' Auswahl reduzieren und Nachricht ausgeben
    Application.EnableEvents = False
    Target(1).Select                        ' nur die erste Zelle des Bereichs wird ausgewählt
    Application.EnableEvents = True
    MsgBox "Es darf nur eine Zelle ausgewählt werden !", vbInformation
End Sub
Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 10.03.2018, 16:45   #73
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

super vielen Dank, das klappt wunderbar

Zitat:

Und dann Dein vorletzter Beitrag:
Zitat:
Dann hätte ich noch ne Frage und zwar haben wir ja die Funktion Fehler anzeige in Grundstellung bringen, was ja auch wunderbar Funktioniert!
Jetzt hab ich noch eine Funktion mit eingebaut, wenn man die Jahreszahl ändert kann man auf Wunsch die Datei mit neuer Jahreszahl neu abspeichern und alle Einträge löschen, klappt auch wunderbar, nur bekomme ich es nicht hin das in allen Monaten die Fehleranzeigen in Grundstellung gebracht werden.
Dann stell mal den aktuellen Code hierfür zur Verfügung.

Hier der Aktuelle Code:
Code:

Sub Anzeigebereich_Löschen(Sh As Worksheet)
    Dim nT As Long                      ' Anzahl Tage im Monat
    Dim r As Long, Z As Long            ' Zeilen#
    Dim c As Long, c1 As Long, c2 As Long          ' Spalten#
    Dim m As Long                       ' Monat
    Dim w As Long                       ' Wochentag
    Dim ABereich As Range               ' Anzeigebereich

'=======================================================================================
' Anzeigebereich Zeilen 64:75 in Grundstellung setzen
'=======================================================================================

' Check Monats-Tabelle und ermittle letzte Spalte des Monatsbereichs
    With Sh
        Select Case .name                   ' Name des aktuellen tabellenblattes
            Case Is = "Januar", "Februar", "März", "Mai", "Juli", "August", "Oktober", "Dezember", _
                        "April", "Juni", "September", "November"
            Case Else
                Exit Sub                    ' kein Monatsblatt
        End Select
        
'' UserForm bitte_warten einblenden
'        Form_bitte_warten.Show vbModeless               'Öffnet das UserForm Bitte warten, bis das Makro fertig ist
'        Application.Wait Now + TimeValue("00:00:01")    'Lässt das Makro eine Sekunde später starten, so das sich das UserForm noch laden kann
    
' Löschen und Einfärben Anzeigebereich in rot
        nT = Day(DateSerial(Year(.Range("C3")), Month(.Range("C3")) + 1, 0))     ' Anzahl Tage im aktuellen Monat
        c1 = 3                              ' Spalte C = Start-Spalte
        c2 = c1 + nT - 1                    ' letzte Spalte Monatsbereich
        With .Range("C64:AG75")             ' maximaler Monatsbereich
            .Interior.ColorIndex = xlNone
            .ClearContents
        End With
        .Range(.Cells(64, "C"), .Cells(75, c2)).Interior.Color = 255
        m = Month(.Range("C3"))             ' Monats# der Tabelle
        
' Spezialbehandlung für Anlage Rodelabend
        Application.EnableEvents = False
        For r = 65 To 67 Step 2
            For c = c1 To c2
                w = Weekday(.Cells(3, c), 2)        ' Wochentag#
                If Not ((m = 12 Or m <= 4) And (w = 2 Or w = 5)) Then           ' kein gültiger Rodelanebd-Termin
                    .Cells(r, c).Interior.ColorIndex = xlNone
                    .Cells(r, c) = "X"
                End If
            Next c
        Next r
        Application.EnableEvents = True
    End With
'    Unload Form_bitte_warten ' Schliest das UserForm Bitte warten, sobald das Makro fertig ist
End Sub
Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 10.03.2018, 19:21   #74
aloys78
MOF Meister
MOF Meister
Standard

Hallo Mirko,

das ist Uralt-Code, der nicht funktionieren kann, da es ja für die Rodelabende eine völlig andere Regelung gibt.

Für den Button Dienstplan Einträge löschen hast Du Lösungsvorschläge für
- Sub DiensplanEinträgeLöschenWinter() in Version 6.4 sowie
- Sub Anzeigebereich_Löschen(Sh As Worksheet) in Version 6.4, das für Sommer und Winter gilt.

Um Dir bei der Frage

Zitat:

Jetzt hab ich noch eine Funktion mit eingebaut, wenn man die Jahreszahl ändert kann man auf Wunsch die Datei mit neuer Jahreszahl neu abspeichern und alle Einträge löschen, klappt auch wunderbar, nur bekomme ich es nicht hin das in allen Monaten die Fehleranzeigen in Grundstellung gebracht werden.

helfen zu können, brauche ich die Steuerungsroutine, die für alle Monate das Löschen des Eingabebereichs durchführt und das Sub Anzeigebereich_Löschen aufruft.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.03.2018, 05:27   #75
okrim
Threadstarter Threadstarter
MOF User
MOF User
Standard

Guten Morgen Aloys,

bin ich blöd wenn man schnell schnell macht, sehe gerade das alt und neu ja die gleiche Sub haben, komisch das Excel nicht gemeckert hat, da der alte Code in einem anderen Modul auch noch drin war??? Egal jetzt ist er raus.
Sorry nochmal, hier jetzt der Aktuelle Code:

Code:

Option Explicit

'===========================================================================
' Button Diensplan Einträge löschen für Winter
'===========================================================================

Sub DiensplanEinträgeLöschenWinter()
' Version v 6.4 vom 04.03.2018

    Dim nT As Long                                  ' Anzahl Tage im Monat
    Dim c As Long, c1 As Long, c2 As Long           ' Spalten#
    Dim Zeit1 As Single, Zeit2 As Single
    With ActiveSheet
        nT = Day(DateSerial(Year(.Range("C3")), Month(.Range("C3")) + 1, 0))     ' Anzahl Tage im aktuellen Monat
        c1 = 3                              ' Spalte C = Start-Spalte
        c2 = c1 + nT - 1                    ' letzte Spalte Monatsbereich
        
        If MsgBox("Wollen Sie die Einträge im Dienstplan wirklich löschen?", vbQuestion + vbYesNo, "Ehrwalder Almbahn") = vbYes Then
            Zeit1 = Timer
            Application.EnableEvents = False
            .Range(.Cells(6, "C"), .Cells(58, c2)).ClearContents
            Application.EnableEvents = True
            Zeit1 = Timer - Zeit1: Zeit2 = Timer
            Call Anzeigebereich_Löschen(ActiveSheet)
            ActiveSheet.Range("C6").Select
            Zeit2 = Timer - Zeit2
        End If
    End With
'    MsgBox "Dauer Löschvorgang: " & Format(Zeit1, "0.00") & " plus " & Format(Zeit2, "0.00")
End Sub

'===========================================================================
' Button Diensplan Einträge löschen für Sommer
'===========================================================================

Sub DiensplanEinträgeLöschenSommer()
' Version v 6.4 vom 04.03.2018

    Dim nT As Long                                  ' Anzahl Tage im Monat
    Dim c As Long, c1 As Long, c2 As Long           ' Spalten#
    Dim Zeit1 As Single, Zeit2 As Single
    With ActiveSheet
        nT = Day(DateSerial(Year(.Range("C3")), Month(.Range("C3")) + 1, 0))     ' Anzahl Tage im aktuellen Monat
        c1 = 3                              ' Spalte C = Start-Spalte
        c2 = c1 + nT - 1                    ' letzte Spalte Monatsbereich
        
        If MsgBox("Wollen Sie die Einträge im Dienstplan wirklich löschen?", vbQuestion + vbYesNo, "Ehrwalder Almbahn") = vbYes Then
            Zeit1 = Timer
            Application.EnableEvents = False
            .Range(.Cells(6, "C"), .Cells(58, c2)).ClearContents
            Application.EnableEvents = True
            Zeit1 = Timer - Zeit1: Zeit2 = Timer
            Call Anzeigebereich_Löschen(ActiveSheet)
            ActiveSheet.Range("C6").Select
            Zeit2 = Timer - Zeit2
        End If
    End With
'    MsgBox "Dauer Löschvorgang: " & Format(Zeit1, "0.00") & " plus " & Format(Zeit2, "0.00")
End Sub

Sub Anzeigebereich_Löschen(Sh As Worksheet)
' Version v 6.4 vom 04.03.2018
    Dim nT As Long                      ' Anzahl Tage im Monat
    Dim r As Long, Z As Long            ' Zeilen#
    Dim c As Long, c1 As Long, c2 As Long          ' Spalten#
    Dim d As Long                       ' Tagesdatum
    Dim m As Long                       ' Monat
    Dim ABereich As Range               ' Anzeigebereich
    Dim erg As Variant                  ' Ergebnis Match
    Dim sZeit As Single

    sZeit = Timer
    With Sh
        Select Case .name                   ' Name des aktuellen tabellenblattes
            Case Is = "Januar", "Februar", "März", "April", "Dezember"                      'Winterzeit
'=======================================================================================
'            Anzeigebereich Zeilen 64:75 in Grundstellung setzen (Winterzeit)
'=======================================================================================

'             Löschen und Einfärben Anzeigebereich in rot
                nT = Day(DateSerial(Year(.Range("C3")), Month(.Range("C3")) + 1, 0))     ' Anzahl Tage im aktuellen Monat
                c1 = 3                              ' Spalte C = Start-Spalte
                c2 = c1 + nT - 1                    ' letzte Spalte Monatsbereich
                Application.EnableEvents = False
                With .Range("C64:AG75")             ' maximaler Monatsbereich
                    .Interior.ColorIndex = xlNone
                    .ClearContents
                End With
                Application.EnableEvents = True
                .Range(.Cells(64, "C"), .Cells(75, c2)).Interior.Color = 255
                m = Month(.Range("C3"))             ' Monats# der Tabelle
        
'            Spezialbehandlung für Anlage Rodelabend, wenn Wintersaison
                If m = 12 Or m <= 4 Then            ' Winterzeit
                    Application.EnableEvents = False
                    For r = 65 To 67 Step 2
                        For c = c1 To c2
                            d = CLng(.Cells(3, c))        ' Datum der aktuellen Spalte
                            erg = Application.Match(d, p_ArrRT, 0)  ' Suche Tagesdatum im Array Rodelabend-Array
                            If Not IsNumeric(erg) Then              ' kein gültiger Rodelabend-Termin
                                .Cells(r, c).Interior.ColorIndex = xlNone
                                .Cells(r, c) = "X"
                            End If
                        Next c
                    Next r
                    Application.EnableEvents = True
                End If
            
            Case Is = "Mai", "Juni", "Juli", "August", "September", "Oktober", "November"   ' Sommerzeit
'=======================================================================================
'            Anzeigebereich Zeilen 64:65 in Grundstellung setzen (Sommerzeit)
'=======================================================================================
'             Löschen und Einfärben Anzeigebereich in rot
                nT = Day(DateSerial(Year(.Range("C3")), Month(.Range("C3")) + 1, 0))     ' Anzahl Tage im aktuellen Monat
                c1 = 3                              ' Spalte C = Start-Spalte
                c2 = c1 + nT - 1                    ' letzte Spalte Monatsbereich
                Application.EnableEvents = False
                With .Range("C64:AG75")             ' maximaler Monatsbereich
                    .Interior.ColorIndex = xlNone
                    .ClearContents
                End With
                Application.EnableEvents = True
                .Range(.Cells(64, "C"), .Cells(65, c2)).Interior.Color = 255
            
            Case Else
                Exit Sub                    ' kein Monatsblatt
        End Select
    
    End With
'    MsgBox Format(Timer - sZeit, "0.##")           ' Gesamtzeit für das Löschen des Tabellenblattes
End Sub

Und das ist der Code wo alles löscht

Code:

Private Sub Button_Fertig_Click()

    Dim nT As Long                              ' Anzahl Tage im Monat zum Diensplaneinträge löschen
    Dim c As Long, c1 As Long, c2 As Long       ' Spalten# zum Diensplaneinträge löschen
    Dim i As Integer
 
'Schaut ob checkBox aktiv ist und Speichert die Diensplan Datei neu
    If Form_jahreswechsel.Controls("CheckBox1").Value = True Then
    
        ActiveWorkbook.SaveAs (akt_pfad & "/" & neue_datei)     'Speichert die Datei
        MsgBox "Der Diensplan " & Sheets("Einstellungen").Range("D4") & " wurde unter " & akt_pfad & "/" & neue_datei & " gespeichert!" _
                , vbInformation, "Ehrwalder Almbahn"

'Löscht sämtliche Diensplan Einträge inkl. Namen ausser die Namen unter Mitarbeiter
    
    ' Schaltet das Diplay Update aus, man sieht nicht was Excel macht bis es wieder angeschaltet wird
    Application.ScreenUpdating = False
    
    ' Diensplan Einträge löschen für Winter
    For i = 1 To 5
        nT = Day(DateSerial(Year(Worksheets(i).Range("C3")), Month(Worksheets(i).Range("C3")) + 1, 0))     ' Anzahl Tage im aktuellen Monat
        c1 = 3                              ' Spalte C = Start-Spalte
        c2 = c1 + nT - 1                    ' letzte Spalte Monatsbereich
        With Worksheets(i).Range(Worksheets(i).Cells(6, "C"), Worksheets(i).Cells(58, c2))             ' maximaler Monatsbereich
            Application.EnableEvents = False
            Worksheets(i).Range(Worksheets(i).Cells(6, "C"), Worksheets(i).Cells(58, c2)).ClearContents
            Application.EnableEvents = True
            Worksheets(i).Range("A6:A58").ClearContents
        End With
    Next i

    ' Diensplan Einträge löschen für Sommer
    For i = 6 To 12
        nT = Day(DateSerial(Year(Worksheets(i).Range("C3")), Month(Worksheets(i).Range("C3")) + 1, 0))     ' Anzahl Tage im aktuellen Monat
        c1 = 3                              ' Spalte C = Start-Spalte
        c2 = c1 + nT - 1                    ' letzte Spalte Monatsbereich
        With Worksheets(i).Range(Worksheets(i).Cells(6, "C"), Worksheets(i).Cells(58, c2))             ' maximaler Monatsbereich
            Application.EnableEvents = False
            Worksheets(i).Range(Worksheets(i).Cells(6, "C"), Worksheets(i).Cells(58, c2)).ClearContents
            Application.EnableEvents = True
            Worksheets(i).Range("A6:A58").ClearContents
        End With
    Next i

    'Selektiert in den Monats Tabellen die Zelle C6
    For i = 1 To 12
        Sheets(i).Select
        Sheets(i).Range("C6").Select
    Next i

    'Springt in Tabellen Einstellungen
    Sheets("Einstellungen").Select
    
    ' Schaltet das Diplay Update ein
    Application.ScreenUpdating = True

        Unload Me
    End If
    Unload Me
End Sub

ich habe es mal so versucht, dachte das es so vielleicht geht

Code:

' Setzt Dezember bis November die Fehleranzeige in Grundstellung
'    For i = 1 To 12
'        Call Anzeigebereich_Löschen(Worksheets(i))
'    Next i
ging aber nicht!

Gruß Mirko
okrim ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:18 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.