+ 1 Tag wenn Wochentag

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: + 1 Tag wenn Wochentag
von: Shawn
Geschrieben am: 22.08.2015 08:01:00

Guten Morgen Excel Experten
Mein Makro bucht beim starten 8 zeilen ein (Anzahl zu abzuarbeitene Aufträge pro Tag) dann wechselt er auf den nächsten Tag bei AG1
in der Zeile Sheets("Eingabe Daten Prod. Auftrag").Range("AG1").Value + 1
aber wenn Samstag ist in AG1 soll er auf Montag bei Sonntag auf Dienstag
das Datum in AG1 brauche ich zum Planen sollte aber immer zwingend ein Wochentag sein
Wie bring ich das hin ?

Sub Lieferschein_DECO()
'

Sub Lieferschein_DECO()
'
' LieferscheinDECO in Daten Produktion einbuchen
'
'
Dim ZeileNr As Long
Dim i As Long
ZeileNr = 19
i = 0
ActiveSheet.Unprotect "shsq"
While Sheets("Vorlage Lieferschein").Range("E" & ZeileNr).Value <> ""
   Sheets("Eingabe Daten Prod. Auftrag").Range("G2").Value = _
    Sheets("Vorlage Lieferschein").Range("E" & ZeileNr).Value
   Sheets("Eingabe Daten Prod. Auftrag").Range("M2").Value = _
    Sheets("Vorlage Lieferschein").Range("C" & ZeileNr).Value
   Sheets("Eingabe Daten Prod. Auftrag").Range("K2").Value = _
    Sheets("Vorlage Lieferschein").Range("H" & ZeileNr).Value
   Sheets("Eingabe Daten Prod. Auftrag").Range("C2").Value = _
    Sheets("Vorlage Lieferschein").Range("B" & ZeileNr).Value
   Call Einbuchen   'Zeile kopieren und einbuchen
                                
   i = i + 1
   If i = 8 Then   '8 zeilen einbuchen dann wieder auf 0
     i = 0
     Sheets("Eingabe Daten Prod. Auftrag").Range("AG1").Value = _
      Sheets("Eingabe Daten Prod. Auftrag").Range("AG1").Value + 1
   End If
   ZeileNr = ZeileNr + 1
Wend
Sheets("Eingabe Daten Prod. Auftrag").Range("AG1").FormulaLocal = "=HEUTE()"
If ZeileNr > 19 Then
    MsgBox "Positionen auf Lieferschein " & ZeileNr - 19
  Else
    MsgBox "Bestellerfassung nicht Ausgeführt da auf Lieferschein E19 Leer ist !"
End If
Sheets("Eingabe Daten Prod. Auftrag").Range("C2").ClearContents
Range("G2").ClearContents
Range("K2").ClearContents
Range("M2").ClearContents
Sheets("Vorlage Lieferschein").Delete
Sheets("Eingabe Daten Prod. Auftrag").Range("V2:Y2").ClearContents
Sheets("Eingabe Daten Prod. Auftrag").Unprotect Password:="shsq"
Sheets("Eingabe Daten Prod. Auftrag").EnableAutoFilter = True
Sheets("Eingabe Daten Prod. Auftrag").Protect UserInterfaceOnly:=True, _
  Password:="shsq"
End Sub

Bild

Betrifft: AW: + 1 Tag wenn Wochentag
von: fcs
Geschrieben am: 23.08.2015 09:47:09
Hallo Shawn,
ich hab dir die entsprechende Prüfung und Apassung des Wertes eingebaut.
Durch Verwendung von Objekt-Variablen für die Tabellenblätter und With ... End With Kontrukte wird der code etwas übersichtlicher und kompakter.
Gruß
Franz

Sub Lieferschein_DECO()
'
' LieferscheinDECO in Daten Produktion einbuchen
'
'
    
    Dim ZeileNr As Long
    Dim i As Long
    Dim wksEingabe As Worksheet, wksVorlage As Worksheet
    
    Set wksEingabe = Sheets("Eingabe Daten Prod. Auftrag")
    Set wksVorlage = Sheets("Vorlage Lieferschein")
    ZeileNr = 19
    i = 0
    
    wksEingabe.Activate
    wksEingabe.Unprotect "shsq"
    Application.ScreenUpdating = False
    While wksVorlage.Range("E" & ZeileNr).Value <> ""
       With wksEingabe
            'Prüfung Samstag/Sonntag
            With .Range("AG1")
                 Select Case Weekday(.Value, vbSunday)
                     Case vbSaturday
                         .Value = .Value + 2
                     Case vbSunday
                         .Value = .Value + 1
                 End Select
            End With
            .Range("G2").Value = wksVorlage.Range("E" & ZeileNr).Value
            .Range("M2").Value = wksVorlage.Range("C" & ZeileNr).Value
            .Range("K2").Value = wksVorlage.Range("H" & ZeileNr).Value
            .Range("C2").Value = wksVorlage.Range("B" & ZeileNr).Value
       
            Call Einbuchen   'Zeile kopieren und einbuchen
                                    
            i = i + 1
            If i = 8 Then   '8 zeilen einbuchen dann wieder auf 0
                 i = 0
                 With .Range("AG1")
                     .Value = .Value + 1
                 End With
            End If
            ZeileNr = ZeileNr + 1
       End With
    Wend
    Application.ScreenUpdating = True
    
    If ZeileNr > 19 Then
        MsgBox "Positionen auf Lieferschein " & ZeileNr - 19
      Else
        MsgBox "Bestellerfassung nicht Ausgeführt da auf " _
            & "Lieferschein E19 Leer ist !"
    End If
    With wksEingabe
        .Range("AG1").FormulaLocal = "=HEUTE()"
        .Range("C2").ClearContents
        .Range("G2").ClearContents
        .Range("K2").ClearContents
        .Range("M2").ClearContents
    wksVorlage.Delete
        .Range("V2:Y2").ClearContents
        .Unprotect Password:="shsq"
        .EnableAutoFilter = True
        .Protect UserInterfaceOnly:=True, Password:="shsq"
    End With
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "+ 1 Tag wenn Wochentag"