in Zelle C1 und D1 läuft eine Uhr mit einem alten Makro von Excel 4.0
Folgendes Makro stört, das starten der Zeit in C1 und in D1.
Es kommt die Meldung Laufzeitfehler 13 "Rücksprung wird nicht gefunden"
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strCell As String, strMaxZeile As String
Dim lngRow As Long, lngMaxZeile As Long
Dim intCounter As Integer, intCountErr As Integer
Dim intCol As Integer
Dim var As Variant
If Target.Column <> 3 Then Exit Sub
strMaxZeile = ActiveWorkbook.Names("Max_Zeilen")
lngMaxZeile = Application.Evaluate(strMaxZeile)
If IsEmpty(Range("C" & Target.Row)) Then
If Selection.Rows.Count = 1 Then
If Target.Row < lngMaxZeile Then
If MsgBox("Sie haben eine Startnummer gelöscht, die sich " & _
"nicht am Ende der Liste befunden hat." & vbLf & vbLf & _
"Um die gesamte Zeile zu Löschen, klicken Sie bitte " & _
"auf ""Ja"", um nur die Inhalte der " & vbLf & _
"Zeile zu löschen wählen Sie bitte ""Nein"".", vbYesNo + vbQuestion) = vbYes Then
Rows(Target.Row).Delete
Else: Range("A" & Target.Row & ":B" & Target.Row).ClearContents
Range("E" & Target.Row & ":M" & Target.Row).ClearContents
End If
Else: Range("A" & Target.Row & ":B" & Target.Row).ClearContents
Range("E" & Target.Row & ":M" & Target.Row).ClearContents
End If
Else
'Beim gleichzeitigen Löschen mehrerer Zellen in C
For intCounter = 1 To Selection.Rows.Count
Range("A" & Target.Row + intCounter - 1 & _
":B" & Target.Row + intCounter - 1).ClearContents
Range("E" & Target.Row + intCounter - 1 & _
":M" & Target.Row + intCounter - 1).ClearContents
Next intCounter
ActiveCell.Select
End If
Exit Sub
End If
With Application
'Bildschirmaktualisierung ausschalten
.ScreenUpdating = False
'Events ausschalten, damit nicht beim Eintragen der Werte
'jedes Mal die Prozedur neu gestartet wird.
.EnableEvents = False
If Selection.Rows.Count = 1 Then
intCol = Target.Column
Else: intCol = ActiveCell.Column
End If
lngRow = Target.Row - 1
For intCounter = 1 To Selection.Rows.Count
var = .VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 2, 0)
If Not IsError(var) Then
Range("E" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 2, 0)
Range("F" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 3, 0)
Range("G" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 4, 0)
Range("H" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 5, 0)
Range("I" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 6, 0)
Range("J" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 7, 0)
Range("K" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 8, 0)
Range("L" & lngRow + intCounter) = _
.VLookup(Cells(lngRow + intCounter, intCol), _
Worksheets("Stammdaten").Columns("A:I"), 9, 0)
Else: MsgBox "Die Startnummer " & Cells(lngRow + intCounter, intCol) _
& " ist in der Tabelle ""Stammdaten"" nicht vorhanden.", vbInformation
For intCountErr = 2 To 9
Cells(lngRow + intCounter, intCol + intCountErr) = "?"
Next intCountErr
End If
Next intCounter
End With
'Wenn Wert in C der betreffenden Zeile > 0 werden die
'Formelergebnisse eingetragen.
If Range("C" & lngRow + 1) > 0 Then
For intCounter = 1 To Selection.Rows.Count
Range("A" & lngRow + intCounter) = _
WorksheetFunction.CountIf(Range("L1:L" & lngRow + intCounter), _
Range("L" & lngRow + intCounter))
Range("M" & lngRow + intCounter) = Range("L" & lngRow + intCounter) & _
Range("I" & lngRow + intCounter)
Range("B" & lngRow + intCounter) = _
WorksheetFunction.CountIf(Range("M1:M" & lngRow + intCounter), _
Range("M" & lngRow + intCounter)) & ". " & _
Range("I" & lngRow + intCounter)
Next intCounter
End If
'Events und Bildschirmaktualisierung wieder einschalten
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
In Office XP tritt dieses Problem nicht auf. Dort läuft alles!
Ich möchte aber das dieses Makro auch in Office 97 läuft.
Vielleicht könnt ihr mir helfen?
Vielen Dank!
Tschüß
Rolf