Makro Stapelspeicher

Hallo
ich habe Probleme mit Stapelspeicher, vor allem wenn beim Case-2,
im unten aufgeführten Makro,
meine Fragen?
was genau passiert da?
kann man Makros auch Teilen?
oder so umschreiben, dass immer nur das jeweilige Case bearbeitet wird
Danke an allen für eure Hilfe
#################################################################################

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("K9:K700")) Is Nothing Then
Application.DisplayAlerts = False
UserId = Environ("Username")
BackUpName = "E:\...\" & ThisWorkbook.Name & "_" & _
Date & "_" & Format(Time, "hhmmss") & "_" & UserId & "_" & ".xlsm"
ThisWorkbook.SaveCopyAs Filename:=BackUpName
Application.DisplayAlerts = True
End If
'----------------------------------------------------------------------------------------------- _
If Intersect(Target, Range("A9:M700")) Is _
Nothing Or Target.Count > 1 Then Exit Sub
Dim myRng As Range
On Error GoTo CleanUp
'----------------------------------------------------------------------------------------------- _
If Target.Column = 1 And Len(Target) > 0 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 6)) _
.Interior.Color = RGB(217, 217, 217)
End If
'----------------------------------------------------------------------------------------------- _
Select Case Target.Column
Case 1
If UCase(Target) = "CALL" Then
Target = UCase(Target)
Target.Resize(1, 4).Font.Color = vbBlue
ElseIf InStr(UCase(Target), "KW") Then
Target = UCase(Target)
Target.Resize(1).Interior.Color = RGB(255, 0, 255)
Target.Resize(1, 4).Font.Color = vbBlue
ElseIf Len(Target) > 0 Then
End If
'----------------------------------------------------------------------------------------------- _
Case 2
Set myRng = Range("B" & Target.Row).Resize(columnsize:=3)
Select Case UCase(Target.Value)
Case "PA", "PX", "PM", "PT"
Target = UCase(Target)
myRng.Font.Color = RGB(255, 0, 0)
Case "RK", "RG"
Target = UCase(Target)
myRng.Font.Color = vbBlue
Case Else
myRng.Font.Color = vbBlack
End Select
'----------------------------------------------------------------------------------------------- _
Case 9
Target = UCase(Target)
'----------------------------------------------------------------------------------------------- _
Case 11
Set myRng = Range("G" & Target.Row).Resize(columnsize:=11)
Select Case Target.Value
Case "Kommission"
myRng.Interior.Color = RGB(255, 255, 0)
myRng.Font.Color = RGB(0, 0, 0)
Case "Fertigung Mech.", "Fertigung Elektrik"
myRng.Interior.Color = RGB(201, 153, 255)
myRng.Font.Color = RGB(0, 0, 0)
Case "Fertigung Optik", "Fertigung SG"
myRng.Interior.Color = RGB(255, 153, 0)
myRng.Font.Color = RGB(0, 0, 0)
Case "Wareneingang", "Wareneingangsprüfung"
myRng.Interior.Color = RGB(0, 255, 255)
myRng.Font.Color = RGB(0, 0, 0)
Case "Montiert"
myRng.Interior.Color = RGB(146, 208, 80)
myRng.Font.Color = RGB(0, 0, 0)
Case "Fertig", "Geliefert"
myRng.Interior.Color = RGB(0, 255, 0)
myRng.Font.Color = RGB(0, 0, 0)
Case "FEHLTEIL", "KLÄRUNG", "GESPERRT"
myRng.Interior.Color = RGB(255, 0, 0)
myRng.Font.Color = RGB(255, 255, 255)
Case "im Zulauf"
myRng.Interior.Color = RGB(255, 255, 255)
myRng.Font.Color = RGB(0, 0, 0)
Case "PA erstellen"
myRng.Interior.Color = RGB(255, 0, 255)
myRng.Font.Color = RGB(0, 0, 0)
Case Else
myRng.Interior.Color = xlNone
myRng.Font.Color = vbBlack
End Select
'----------------------------------------------------------------------------------------------- _
Case 12
Select Case Target.Value
Case "8001", "8013", "8003", "8030", "QS", "Wäsche", "Reklamation"
Target.Font.Color = RGB(255, 0, 0)
Target.Font.Bold = True
Target.Font.Italic = True
Case Else
Target.Font.Color = vbBlack
Target.Font.Bold = False
Target.Font.Italic = False
End Select
'----------------------------------------------------------------------------------------------- _
Case 13
If Len(Target) > 0 Then Target = UCase(Target)
Target.Interior.Color = IIf(Target = "PRIO", RGB(255, 0, 255), Target.Offset(, 1). _
Interior.Color)
Target.Font.Color = IIf(Target = "PRIO", RGB(255, 255, 0), vbBlack)
Range("C" & Target.Row).Interior.Color = IIf(Target = "PRIO", RGB(255, 0, 255),  _
Target.Offset(, -9).Interior.Color)
Range("C" & Target.Row).Font.Color = IIf(Target = "PRIO", RGB(255, 255, 0), Target. _
Offset(, -9).Font.Color)
End Select
CleanUp:
End Sub

#################################################################################

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public spalten As Variant Public UserId As String Public BackUpName As String Sub initSpalten() spalten = Array(1, 2, 8, 9, 11, 12, 13) End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim vgl As String initSpalten 'Stop If Target.Count = 1 Then If Application.Match(Target.Column, spalten, 0) > 0 Then If Target.Row > 8 And Target.Row "" Then vgl = UCase(CStr(Target.Value)) Application.EnableEvents = False If Target.Column = 1 Then Target.Resize(1, 6).Interior.Color = RGB(217, 217, 217) If vgl = "CALL" Then Target = vgl Target.Resize(1, 4).Font.Color = vbBlue ElseIf InStr(vgl, "KW") Then Target = vgl Target.Interior.Color = RGB(255, 0, 255) Target.Resize(1, 4).Font.Color = vbBlue End If Else If Target.Column = 2 Then If InStr("KW-PA-PX-PM-PT", vgl) > 0 Then Target = vgl: Target.Resize(1, 3).Font.Color = RGB(255, 0, 0) ElseIf InStr("RK-RG", vgl) > 0 Then Target = vgl: Target.Resize(1, 3).Font.Color = vbBlue Else: Target.Resize(1, 3).Font.Color = vbBlack End If Else If Target.Column = 9 Then Target = vgl Else If Target.Column = 11 Then Select Case Target.Value Case "Kommission" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(255, 255, 0) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case "Fertigung Mech.", "Fertigung Elektrik" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(201, 153, 255) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case "Fertigung Optik", "Fertigung SG" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(255, 153, 0) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case "Wareneingang", "Wareneingangsprüfung" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(0, 255, 255) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case "Montiert" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(146, 208, 80) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case "Fertig", "Geliefert" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(0, 255, 0) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case "FEHLTEIL", "KLÄRUNG", "GESPERRT" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(255, 0, 0) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(255, 255, 255) Case "im Zulauf" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(255, 255, 255) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case "PA erstellen" Target.Offset(0, -4).Resize(1, 11).Interior.Color = RGB(255, 0, 255) Target.Offset(0, -4).Resize(1, 11).Font.Color = RGB(0, 0, 0) Case Else Target.Offset(0, -4).Resize(1, 11).Interior.Color = xlNone Target.Offset(0, -4).Resize(1, 11).Font.Color = vbBlack End Select Else MsgBox "Hier alles andere einfügen, bis auf" End If End If End If End If Application.EnableEvents = True MsgBox "Die Abfrage auf Spalte 8 - hier nach dem enable=true" End If End If End If End If End Sub

Hi Michael
Sorry für die späte Rückmeldung.
Habe durch mein Baby ein wenig Zeit.
Habe aber schon mal angefangen und schon ein Problem.
siehe unten
es funktioniert aber nicht bei "Wäsche" und "Rekla"
selbst wenn ich diese beiden getrennt einspiele keine Funktion
woran könnte dieses liegen
musste das größer gleich Zeichen entfernen nach vgl) weil ich diese sonst nicht versenden kann
Danke schön
BG
"If Target.Column = 12 Then
If InStr("8001-8003-8030-Wäsche-Rekla", vgl) 0 Then
Target = vgl: Target.Resize(1).Font.Color = RGB(255, 0, 0)
Target.Font.Bold = True
Target.Font.Italic = True
ElseIf InStr("QS-Wäsche-Rekla", vgl) 0 Then
Target = vgl: Target.Resize(1).Font.Color = RGB(255, 0, 0)
Target.Font.Bold = True
Target.Font.Italic = True
Else
Target.Font.Color = vbBlack
Target.Font.Bold = False
Target.Font.Italic = False"

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread