Makro beschleunigen

Hallo liebes Forum,
ich bin wiedermal soweit das ich Hilfe benoetige. Ich habe eine wunderschoene Exceltabelle gemacht, leider hat sie sich in der Praxis als etwas untauglich erwiesen. Ich lasse den VBA Code nach druecken der F9 Taste durchlaufen. Leider muss aber der VBA CODE immer rund 400 Zeilen durchlaufen und das dauert immer so 30 Sek, was ich fuer zu lange halte.
Gibt es irgendeine Moeglichkeit es nicht mit einer FOR Schleife zu loesen. Ich habe schon etwas mit If ActiveCell.Address und If Target.Address versucht aber ohne Erfolg. Theoretisch sollte es ja auch einfach mit Change funktionieren, also das updaten nach Aenderung einer Zelle. Allerdings muesste ich dafuer die aktuelle Zeile auslesen, um die FOR Schleife zu umgehen. Habe leider keine Ahnung wie das funktionieren soll.
Ich habe mal die BASIC Version meiner Exceltabelle mit hochgeladen. Fuer Hilfe bin ich auesserst dankbar. (Eigentlich sollte es auch moeglich sein Bier zu mailen, da mit man sich auch mal erkenntlich zeigen kann ;-)
Vielen Dank Alex
PS: Der Link zur Datei
https://www.herber.de/bbs/user/26994.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Alex,
deim Makro duchläuft immer alle If - Abfragen. So sollte es schon etwas schnelle laufen:
Private Sub Update2_Click()
    Dim m As Long
    Application.ScreenUpdating = False
    For m = 8 To Range("a65536").End(xlUp).Row
        Select Case Cells(m, 7)
            Case "Stores"
                Cells(m, 7).Interior.ColorIndex = 5
                Cells(m, 7).Font.ColorIndex = 2
            Case "Goods Inwards"
                Cells(m, 7).Interior.ColorIndex = 53
                Cells(m, 7).Font.ColorIndex = 2
            Case "Procurement"
                Cells(m, 7).Interior.ColorIndex = 43
                Cells(m, 7).Font.ColorIndex = 1
            Case "Order Revised"
                Cells(m, 7).Interior.ColorIndex = 44
                Cells(m, 7).Font.ColorIndex = 1
            Case "Order on Hold"
                Cells(m, 7).Interior.ColorIndex = 27
                Cells(m, 7).Font.ColorIndex = 1
            Case "Order Late"
                Cells(m, 7).Interior.ColorIndex = 3
                Cells(m, 7).Font.ColorIndex = 2
            Case "Order Rejected"
                Cells(m, 7).Interior.ColorIndex = 45
                Cells(m, 7).Font.ColorIndex = 1
            Case "Short Delivery"
                Cells(m, 7).Interior.ColorIndex = 46
                Cells(m, 7).Font.ColorIndex = 1
            Case "Not Started"
                Cells(m, 7).Interior.ColorIndex = 2
                Cells(m, 7).Font.ColorIndex = 1
            Case "Free to Order"
                Cells(m, 7).Interior.ColorIndex = 38
                Cells(m, 7).Font.ColorIndex = 1
        End Select
    Next m
    Application.ScreenUpdating = True
End Sub

Noch besser wäre es, wenn du das ganze in eine Ereignisprozedur bringst. Damit müsste dann immer nur die geänderte Zeile bearbeitet werden. Beispielsweise so:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objCell As Range
    If Target.Column = 7 Then
        For Each objCell In Target
            Select Case objCell.Text
                Case "Stores"
                    objCell.Interior.ColorIndex = 5
                    objCell.Font.ColorIndex = 2
                Case "Goods Inwards"
                    objCell.Interior.ColorIndex = 53
                    objCell.Font.ColorIndex = 2
                Case "Procurement"
                    objCell.Interior.ColorIndex = 43
                    objCell.Font.ColorIndex = 1
                Case "Order Revised"
                    objCell.Interior.ColorIndex = 44
                    objCell.Font.ColorIndex = 1
                Case "Order on Hold"
                    objCell.Interior.ColorIndex = 27
                    objCell.Font.ColorIndex = 1
                Case "Order Late"
                    objCell.Interior.ColorIndex = 3
                    objCell.Font.ColorIndex = 2
                Case "Order Rejected"
                    objCell.Interior.ColorIndex = 45
                    objCell.Font.ColorIndex = 1
                Case "Short Delivery"
                    objCell.Interior.ColorIndex = 46
                    objCell.Font.ColorIndex = 1
                Case "Not Started"
                    objCell.Interior.ColorIndex = 2
                    objCell.Font.ColorIndex = 1
                Case "Free to Order"
                    objCell.Interior.ColorIndex = 38
                    objCell.Font.ColorIndex = 1
            End Select
        Next
    End If
End Sub

Gruß
Nepumuk

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Target ist die Range Variable mit Wert und Adresse dim bereich,gebiet as range dim wert dim zeile dim spalte if target.count=1 then 'wenn nur eine Zelle selektiert set bereich =taget.offset(1,1) wert=target '=Inhalt der Zelle zeile=target.row 'Zeilenindex von Target spalte=target.column 'Spaltenindex von Target endif set gebiet=range("A1:C3") if not (intersect(target,gebiet) is noting then 'wenn Target sich in A1:C3 befindet end if End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread