AW: Absturz bei VergleichsMakro
04.04.2011 20:04:13
Chris
Hallo Hajo,
danke für dein Vorschlag. Leider stürzt Excel immer noch ab, sobald der Wert in J44 KLEINER ist als in J45. Das makro von mir ist teil einer ganzen kette von makros, die alle problemlos laufen, bis auf das letzte. Ich kopiere mal das ganze rein, vielleicht übersehe ich ja was:
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Dim rng As Range 'Rangevariable, nimmt die Doppelklick-Zelle auf
Dim blnPaste As Boolean
Dim anzahlPK As Integer
Dim anzahlPF As Integer
Dim i As Long
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel _
As Boolean)
Cancel = True 'Cancel = True ist nötig um nicht in den Bearbeitungsmodus zu wechseln
Set rng = Target.Resize(1, 4) 'Variable füllen
blnPaste = True 'Einfügen aktivieren
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As _
Boolean)
Cancel = True 'Cancel = True ist nötig um nicht das Kontextmenü zu öffnen
If Not rng Is Nothing Then 'Gibt's was einzufügen
If blnPaste Then 'wenn Einfügen aktiv
rng.Copy Target(1, 1)
Target(1, 1) = rng.Value
Else 'Einfügen nicht aktiv
Target(1, 1).Resize(1, 4).Clear
End If
blnPaste = Not blnPaste 'Einfügen Toggeln
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Dim Zelle As Range
Dim Ziel As Range
Application.EnableEvents = False
For Each Zelle In Target
If Not Intersect(Zelle, Range("K46:K53,O46:O53,S46:S53,W46:W53,AA46:AA53")) Is Nothing Then
Set Ziel = Worksheets(3).Cells(44, 10)
ElseIf Not Intersect(Zelle, Range("K85:K92,O85:O92,S85:S92,W85:W92,AA85:AA92")) Is Nothing _
Then
Set Ziel = Worksheets(3).Cells(83, 10)
ElseIf Not Intersect(Zelle, Range("K124:K131,O124:O131,S124:S131,W124:W131,AA124:AA131")) _
Is Nothing Then
Set Ziel = Worksheets(3).Cells(122, 10)
End If
If Not Ziel Is Nothing Then
Ziel.Value = Ziel.Value - Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value
Select Case Zelle.Value
Case "LP"
Ziel.Value = Ziel.Value + 0.5
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = "0.5"
Case "TRR"
Ziel.Value = Ziel.Value + 0.5
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = 0.5
Case "------"
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = ""
Case Else
Ziel.Value = Ziel.Value + 1
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = "1"
End Select
Set Ziel = Nothing
End If
Next Zelle
Fehler:
Application.EnableEvents = True
Dim Zelle1 As Range
Dim Zelle2 As Range
Dim Zelle3 As Range
Set Zelle1 = Range("J24")
Set Zelle2 = Range("B45")
Set Zelle3 = Range("B84")
If Range("K34").Value > 0 Then
If Range("J44").Value > Range("J37").Value Then
Zelle1.Font.ColorIndex = 3
Else
If Range("K34").Value > 0 Then
If Range("J44").Value Range("J45").Value Then
Zelle1.Font.ColorIndex = 3
Else
If Range("J44").Value Range("B65").Value Then
Zelle2.Font.ColorIndex = 3
Else
If Range("B66").Value Range("B104").Value Then
Zelle3.Font.ColorIndex = 3
Else
If Range("B105").Value 0 Then
anzahlPK = anzahlPK + 1
End If
Range("L10").Value = anzahlPK
Next i
'anzahlPF = 0
If Range("J44").Value >= Range("J45").Value Then
'anzahlPF = anzahlPF + 1
ElseIf Range("J44").Value