Macro Geschwindigkeit

Private Sub Worksheet_Change(ByVal Target As Range) Dim wks As Worksheet Dim iCol As Integer Dim iHilf As Integer If Target.Row Mod 3 = 0 Then Exit Sub iHilf = Int((Target.Row + 2) / 3) - 1 Set wks = Worksheets("Data") iCol = Target.Column Application.EnableEvents = False On Error GoTo ERRORHANDLER If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _ Not IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then Cells(iHilf * 3 + 1, iCol) = "(" & Cells(iHilf * 3 + 1, iCol) & ")" End If If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _ IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then Cells(iHilf * 3 + 1, iCol).NumberFormat = "@" End If If Cells(iHilf * 3 + 2, iCol) = "" And Left(Cells(iHilf * 3 + 1, iCol), 1) = "(" Then Cells(iHilf * 3 + 1, iCol) = Mid(Cells(iHilf * 3 + 1, iCol), 2, 1) End If ERRORHANDLER: Application.EnableEvents = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rolf,
es liegt wirklich an den Arrayformeln (Teufelszeug, würde ich nie verwenden). Da hilft nur eins. In das Klassenmodul "DieseArbeitsmappe" folgender Code:

Option Explicit
Private Sub Workbook_Activate()
Application.Calculation = xlCalculationManual
End Sub
Private Sub Workbook_Deactivate()
Application.Calculation = xlCalculationAutomatic
End Sub

Das Modul der Tabellen habe ich geändert. Denn, wenn in der oberen Zeile z.B. Ur stand, ich darunter k eingetragen habe, hat er aus UR - (Ur) gemacht. Habe ich das k wieder gelöscht, stand darüber nur noch U.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wks As Worksheet
    Dim iCol As Integer
    Dim iHilf As Integer
    If Target.Row Mod 3 = 0 Then Exit Sub
    iHilf = Int((Target.Row + 2) / 3) - 1
    Set wks = Worksheets("Data")
    iCol = Target.Column
    Application.EnableEvents = False
    On Error GoTo ERRORHANDLER
    If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
        Not IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
        Cells(iHilf * 3 + 1, iCol) = "(" & Cells(iHilf * 3 + 1, iCol) & ")"
    End If
    If Not IsError(Application.Match(Cells(iHilf * 3 + 1, iCol).Value, wks.Columns(1), 0)) And _
        IsError(Application.Match(Cells(iHilf * 3 + 2, iCol).Value, wks.Columns(3), 0)) Then
        Cells(iHilf * 3 + 1, iCol).NumberFormat = "@"
    End If
    If Cells(iHilf * 3 + 2, iCol) = "" And Left(Cells(iHilf * 3 + 1, iCol), 1) = "(" Then
        Cells(iHilf * 3 + 1, iCol) = Mid(Cells(iHilf * 3 + 1, iCol), 2, Len(Cells(iHilf * 3 + 1, iCol)) - 2)
    End If
    ActiveSheet.Calculate
ERRORHANDLER:
    Application.EnableEvents = True
End Sub

Gruß
Nepumuk

Hallo Nepumuk,
ach so du meinst die Summenformeln am Ende der Spalten in der Tabelle?
=SUMME(WENN($B4:$B123="ex";WENN(I4:I123="F";1;0);0)+(WENN($B4:$B123="ex";WENN(I4:I123="F1";0,5;0);0))+(WENN($B4:$B123="ex";WENN(I4:I123="F2";1;0);0))+(WENN($B4:$B123="ex";WENN(I4:I123="GFI";0,7;0);0))+(WENN($B4:$B123="ex";WENN(I4:I123="CBF";1;0);0))+(WENN($B4:$B123="ex";WENN(I4:I123="MMF";1;0);0))+(WENN($B4:$B123="ex";WENN(I4:I123="KKI";0,6;0);0)))
Das sind ganz einfache Summenformeln (Funktionen), die in Anhängigkeit eines Eintrages, einen Wert zählen sollen. Wenn z.B. ein ex bei einem Mitarbeiter steht, dann zähle in mit 1 wenn dieser einen Dienst macht der F heißt. Wenn dieser Mitarbeiter einen KKI Dienst macht, dann zähle nur 0,6 als Zähler dazu und gebe ihn jeweils in einem besonderen Feld aus.
Mit diesen Funktionen war die Tabelle genau und recht flott. Erst als das Makro ins Spiel kam, wurde alles sehr langsam.
Da es sich um einen Dienstplan handelt, sollen die Anzahl der Mitarbeiter an den jeweiligen Tagen (Spalten) in Abhängigkeit des Dienstes eines Mitarbeiters und dessen Qualifikation gezählt werden. Die Tabelle handelt über 4 Wochen, oder auch 28 Tage, deswegen auch die 28 Spaltenzähler.
In den Spaltenzählern soll je nach Qualifikation stehen, wenn z.B. ein Mitarbeiter mit der Qualifikation ex einen S oder F Dienst hat. Das wird für verschiedene Qualifikationen ausgegeben. Gleichzeitig gibt es verschiedene Voraussetzungen, bei der keine Zählung in der Spalte erfolgen darf. Z.B. wenn der MA krank ist, den Dienst tauschen muss oder in Urlaub geht. Der Eintrag muss aber trotzdem angezeigt werden, da die Stunden auch bei K oder Ur aufgelistet bleiben und in der Zeile des Mitarbeiters rechts summiert werden.
Um dies zu erreichen, habe ich die Einträge des Dienstes einfach in Klammer gesetzt. Somit sind Zeilensummen erhalten geblieben, die Spaltensummen aber nicht.
Beispiel
Zeile 1 S
Zeile 2
Zeile 3 7
geändert
Zeile 1 (S)
Zeile 2 Ur
Zeile 3 7
Bisher wurden die Klammern von den Mitarbeitern manuell gesetzt. Da die Tabelle ständig Änderungen erfährt ist dies aber sehr mühsam. Dienst eintragen dann Klammern setzen und später wieder entfernen und an andrer Stelle setzen.
Also habe ich seinerzeit hier um Hilfe gebeten und jemanden gefunden der mir ein Makro programmiert hatte um die Klammern automatisch setzen zu lassen.
Da die Kriterien zum Setzen der Klammern und der Stundenanzeige der einzelnen Dienste Variable sind, habe ich mir mit der Hilfstabelle DATA geholfen.
Das hat eigentlich auch gut funktioniert, nur wurde das Ganze sehr langsam und somit unpraktikabel in der Praxis.
Da es sich um Variable handelt, brächte ich die Hilfstabelle mit der Möglichkeit hier Einträge vorzunehmen.
Du meinst, dass die Funktionen das Makro beinflussen?
Hm, Bisher habe ich in der 3. Zeile ebenso eine Funktion eingesetzt, welche mir den SVERWEIS erspart hatte. Durch die automatische Klammersetzung habe ich diesen aber gebraucht.
Was meinst du dazu?
Gruß Rolf

Beliebteste Forumthreads (12 Monate)

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread