Wer kann mir helfen ein VBA Script zu ändern?

Bild

Betrifft: Wer kann mir helfen ein VBA Script zu ändern?
von: Darkman
Geschrieben am: 14.02.2005 13:53:43
Hallo,
Ich habe ein großes Problem mit einem VBA Script.
Ich habe diesen Script vor einiger Zeit zur Verfügung gestellt bekommen.
Dabei handelt es sich um einen Wochenarbeitsplan welcher die Arbeiten auf die Tage einer Woche verteilt.
Der script ist so geschrieben, das er wenn einen Arbeit länger als einen Arbeitstag dauert automatisch einen neuen Vorgang für den nächsten tag macht. es handelt sich hirbei um eine Excel Tabelle mit intgriertm VBA Script.
Wer kann mir helfen das der Überschlag auf den nächsten tag nicht wie bisher nach 8,25 Stunden erfolgt, sondern schon nach 7,5 Stunden???
Bin für jede Hilfe dankbar...
Das Beispile zeigt die Rohdaten welche aus SAP herausgeholt werden bevor das Makro ausgeführt wird.
Hier das Beispiel:
https://www.herber.de/bbs/user/18039.xls
Wer mir helfen möchte kann das Excel Sheet mit dem VBA Script auch gerne per Mail geschickt bekommen.
Meinen E-Mail ist
juergen.dauer@arcor.de
Vielen Dank schon mal...

Bild

Betrifft: AW: Wer kann mir helfen ein VBA Script zu ändern?
von: NIke
Geschrieben am: 14.02.2005 14:11:04
Hi,
du kannst das VB Script auch einfach hier posten,
ich nehme stark an, man muss nur an einer Ecke schrauben ;-)
Bye
Nike
Bild

Betrifft: AW: Wer kann mir helfen ein VBA Script zu ändern?
von: Darkman
Geschrieben am: 14.02.2005 14:17:07
OK dann ist hier das Script...
Es reicht allerdings nicht die Zeile if Arbeitvorrat> 8.25 Then.. zu ändern das habe ich schon probiert.
Vielen Dank schon mal...
Option Explicit

Sub Arbeitsplan()
Dim lZeile
Dim lSpalte
Dim i
Dim Arbeitsvorrat
Dim Startzeit
Dim Endzeit
Dim Tagesstunden
Dim bstartZeile As Boolean
Dim rowCount As Integer
Cells(1, 7).EntireColumn.Insert     'Spalte Tagesstunden einfügen
Cells(1, 7) = "Tagesstunden"
Cells(1, 17).EntireColumn.Insert     'Spalte Kennzeichen einfügen
Cells(1, 17) = "Kennzeichen"
lZeile = Cells(65000, 1).End(xlUp).Row
lSpalte = Cells(1, 200).End(xlToLeft).Column
For i = 2 To lZeile
    DoEvents
    Cells(i, 2) = TimeValue(Cells(i, 2)) * 24
    Cells(i, 4) = TimeValue(Cells(i, 4)) * 24
    Cells(i, 8) = Cells(i, 8) / Cells(i, 10)
Next i
i = 2
bstartZeile = True
Do While i <= lZeile
    DoEvents
    Arbeitsvorrat = Cells(i, 8)
    If bstartZeile = True Then                  '****** 1. Zeile *****
        rowCount = i + 1
        If Arbeitsvorrat > (15 - Cells(i, 2)) Then
            Cells(rowCount, 1).EntireRow.Insert
            Range(Cells(i, 1), Cells(i, lSpalte)).Copy
            Range(Cells(rowCount, 1), Cells(rowCount, lSpalte)).PasteSpecial xlValues
            Application.CutCopyMode = False
            Cells(rowCount, 3) = Cells(rowCount, 1)       'Enddatum = Startdatum
            Cells(i, 17) = "O"
            Startzeit = Cells(rowCount, 2)
            If Arbeitsvorrat > 8.25 Then
                If Startzeit + Arbeitsvorrat > 15 Then
                    Endzeit = Startzeit + Arbeitsvorrat
                    Arbeitsvorrat = Endzeit - 15
                    Cells(rowCount, 8) = Arbeitsvorrat
                    Endzeit = 15
                    Cells(rowCount, 4) = Endzeit
                    Tagesstunden = Endzeit - Startzeit
                    Cells(rowCount, 7) = Tagesstunden
                Else
                    Endzeit = Startzeit + Arbeitsvorrat
                    Cells(rowCount, 4) = Endzeit
                    Tagesstunden = Endzeit - Startzeit
                    Cells(rowCount, 7) = Tagesstunden
                    Arbeitsvorrat = Arbeitsvorrat - Tagesstunden
                End If
            Else
                If Startzeit + Arbeitsvorrat > 15 Then
                    Endzeit = Startzeit + Arbeitsvorrat
                    Arbeitsvorrat = Endzeit - 15
                    Cells(rowCount, 8) = Arbeitsvorrat
                    Endzeit = 15
                    Cells(rowCount, 4) = Endzeit
                    Tagesstunden = Endzeit - Startzeit
                    Cells(rowCount, 7) = Tagesstunden
                Else
                    Endzeit = Startzeit + Arbeitsvorrat
                    Cells(rowCount, 4) = Endzeit
                    Tagesstunden = Endzeit - Startzeit
                    Cells(rowCount, 7) = Tagesstunden
                    Arbeitsvorrat = Arbeitsvorrat - Tagesstunden
                End If
            End If
            If Arbeitsvorrat = 0 Then
                bstartZeile = True
            Else
                bstartZeile = False
            End If
            Cells(rowCount, 8) = Arbeitsvorrat
        Else
        End If
        lZeile = Cells(65000, 1).End(xlUp).Row
    Else                                        '***** restliche Zeilen ******
        rowCount = i + 1
        Do While Arbeitsvorrat > 0
            DoEvents
            Cells(rowCount, 1).EntireRow.Insert
            Range(Cells(rowCount - 1, 1), Cells(rowCount - 1, lSpalte)).Copy
            Range(Cells(rowCount, 1), Cells(rowCount, lSpalte)).PasteSpecial xlValues
            Application.CutCopyMode = False
            If Weekday(Cells(rowCount, 1), 2) = 5 Then
                Cells(rowCount, 1) = Cells(rowCount, 1) + 3 'Wochenende überspringen
                Else: Cells(rowCount, 1) = Cells(rowCount, 1) + 1 'Datum ein Tag weiterzählen
            End If
            Startzeit = 6.75
            Cells(rowCount, 2) = Startzeit
            Cells(rowCount, 3) = Cells(rowCount, 1)       'Enddatum = Startdatum
            If Arbeitsvorrat > 6 Then
                Endzeit = 15
                Cells(rowCount, 4) = Endzeit
            Else
                Endzeit = Startzeit + Arbeitsvorrat
                Cells(rowCount, 4) = Endzeit
            End If
            Tagesstunden = Endzeit - Startzeit
            Cells(rowCount, 7) = Tagesstunden
            Arbeitsvorrat = Arbeitsvorrat - Tagesstunden
            Cells(rowCount, 8) = Arbeitsvorrat
            rowCount = rowCount + 1
            If Arbeitsvorrat = 0 Then
                bstartZeile = True
                i = rowCount - 1
            Else
                bstartZeile = False
            End If
        Loop
        lZeile = Cells(65000, 1).End(xlUp).Row
    End If
    If i > lZeile Then
        i = lZeile
    Else
        i = i + 1
    End If
Loop
lZeile = Cells(65000, 1).End(xlUp).Row
Range(Cells(2, 2), Cells(lZeile, 2)).NumberFormat = "#,##0.00"
Range(Cells(2, 4), Cells(lZeile, 4)).NumberFormat = "#,##0.00"
Range(Cells(2, 7), Cells(lZeile, 7)).NumberFormat = "#,##0.00"
Range(Cells(2, 8), Cells(lZeile, 8)).NumberFormat = "#,##0.00"
 For i = 2 To lZeile
   DoEvents
    Cells(i, 2) = Cells(i, 2) / 24
    Cells(i, 2).NumberFormat = "hh:mm"
    Cells(i, 4) = Cells(i, 4) / 24
    Cells(i, 4).NumberFormat = "hh:mm"
Next i
lZeile = Cells(65000, 1).End(xlUp).Row
lSpalte = Cells(1, 200).End(xlToLeft).Column
Cells(1, 18).EntireColumn.Insert     'Spalte Kennzeichen einfügen
Cells(1, 18) = "CATS-Stunden"
For i = 2 To lZeile
    DoEvents
        If Cells(i, 7) > 0 Then
           Cells(i, 18) = Cells(i, 7) * Cells(i, 10)
        Else
           Cells(i, 18) = Cells(i, 8) * Cells(i, 10)
        End If
Next i
lZeile = Cells(65000, 1).End(xlUp).Row
lSpalte = Cells(1, 200).End(xlToLeft).Column
Columns("H:H").Select
Selection.Copy
Columns("R:R").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Application.CutCopyMode = False
Columns("R:R").Select                    'überflüssige Spalten löschen
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("A:N").Select                        'Sortierung
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
lZeile = Cells(65000, 1).End(xlUp).Row
lSpalte = Cells(1, 200).End(xlToLeft).Column
Cells(1, 1).EntireColumn.Insert     'Spalte Wochentag einfügen
Cells(1, 1) = "Tag"
Range("B1").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Application.CutCopyMode = False
For i = 2 To lZeile                             'Wochentage berechnen
    DoEvents
    If Weekday(Cells(i, 2), 2) = 1 Then
        Cells(i, 1) = "Montag"
    Else
        If Weekday(Cells(i, 2), 2) = 2 Then
        Cells(i, 1) = "Dienstag"
        Else
            If Weekday(Cells(i, 2), 2) = 3 Then
            Cells(i, 1) = "Mittwoch"
            Else
                If Weekday(Cells(i, 2), 2) = 4 Then
                Cells(i, 1) = "Donnerstag"
                Else
                    If Weekday(Cells(i, 2), 2) = 5 Then
                    Cells(i, 1) = "Freitag"
                    Else
                        If Weekday(Cells(i, 2), 2) = 6 Then
                        Cells(i, 1) = "Samstag"
                        Else
                            If Weekday(Cells(i, 2), 2) = 7 Then
                            Cells(i, 1) = "Sonntag"
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
Next i
Range("A1").Select                              'Rasterformat einrichten
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
    
Range("A1").Select                             'Summenzeilen ausblenden
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
Selection.AutoFilter Field:=15, Criteria1:="="
Range("A1").Select
Columns("A:P").Select
Columns("A:P").EntireColumn.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
End Sub

Bild

Betrifft: AW: Wer kann mir helfen ein VBA Script zu ändern?
von: UweD
Geschrieben am: 14.02.2005 14:16:29
Hallo

ohne jetzt das ganze Makro zu studieren...

8.25 kommt nur an einer Stelle vor..

...
            Startzeit = Cells(rowCount, 2)
            If Arbeitsvorrat > 8.25 Then
                If Startzeit + Arbeitsvorrat > 15 Then
                    Endzeit = Startzeit + Arbeitsvorrat
...

Dann müsste dort deine Änderung rein.

Gruß UweD
Bild

Betrifft: AW: Wer kann mir helfen ein VBA Script zu ändern?
von: Peter Feustel
Geschrieben am: 14.02.2005 14:21:40
Hallo Darkmann,
die einzige Stelle, in der 8.25 vorkam, habe ich in 7.5 geändert.
Versuch es also damit mal.
Gruß Peter
https://www.herber.de/bbs/user/18043.xls
Bild

Betrifft: Nur so haut's hin
von: EtoPHG
Geschrieben am: 14.02.2005 14:48:08
Hallo Darkman oder Jürgen ?
Hier ist deine Mappe mit geändertem Code.
Die 8.25 errechnen sich aus der Startzeit und der Endzeit.
Da diese als fixe Konstanten im Script standen funktioniert alles obige schlecht oder nicht.
Ich hab sie an den Anfang des Codes gestellt, wo sie einfacher geändert werden können.
https://www.herber.de/bbs/user/18046.xls

Gruss Hansueli
Bild

Betrifft: AW: Nur so haut's hin
von: Darkman
Geschrieben am: 14.02.2005 15:42:30
Hallo Hansueli
super das funktioniert!!!
Vielen vielen Dank für den Script.
Muß der Script eigentlich so groß sein für die paar Aktionen die ausgeführt werden
(Wochentage einfügen, einige Spalten loschen, Autofilter setzen, überschlag auf neuen Tag bei Arbeit größer 7,5 Stunden)
Ich habe ja nicht wirklich Ahnung davon,aber ein Script von vier seiten dafür finde ich doch sehr sehr viel.
Nochmal vielen Dank an dich und alle die mir so schnell geholfen habe.
Da wird sich mein Chef morgen feuen... ;-)
Grüsse
Jürgen
Bild

Betrifft: AW: Nur so haut's hin
von: EtoPHG
Geschrieben am: 14.02.2005 15:52:26
Hallo Jürgen,
Freut mich, das es funktioniert. Ob der Script so gross sein muss ?
Keine Ahnung, ich hatte zu wenig Zeit um ihn genau zu analysieren.
Aber da "alle Wege nach Rom führen" gibt es vermutlich schon Verbesserungspotential.
Allerdings gilt auch der Satz "Never touch a running system..."
Gruss Hansueli
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Wer kann mir helfen ein VBA Script zu ändern?"