Unterbrechung der Codeausführung
08.12.2006 10:47:34
Marco
ich habe ein Makro gebaut, welches Mehrfachnennungen in einer Liste sucht und jeden Datensatz, egal wie oft er vorkommt, nur einmal in einem anderen Blatt speichert.
Das Makro funktioniert auch wunderbar. Jetzt hat ein Kollege eine Tabelle mit ca. 50000 Zeilen damit abgrasen wollen und das dauert nun mal eine ganze Weile. Mein Problem ist nun, dass ich den Code außer mit Strg+Unterbrechen nicht stoppen kann.
Alle Losungen mit END oder was auch immer funktionieren nicht. Ich kann ja im Formular nichts drücken, da nur eine Sanduhr angezeigt wird. Auch die Esc-Taste reagiert nicht (auch nicht, wenn man diese über Application.EnableCancelKey in eine Fehlerbehandlungsroutine einsetzt).
Hier der Code der Schleife, dessen Ausführung unterbrochen werden soll:
For iRow = iRowLast To iStartRow Step -1
iAnzahl = WorksheetFunction.CountIf(ActiveWorkbook.Sheets(iActiveSheet).Columns(iColSeek), _
ActiveWorkbook.Sheets(iActiveSheet).Cells(iRow, iColSeek))
If WorksheetFunction.CountIf(ActiveWorkbook.Sheets(iActiveSheet).Columns(iColSeek), _
ActiveWorkbook.Sheets(iActiveSheet).Cells(iRow, iColSeek)) > 1 Then
If WorksheetFunction.CountIf(ActiveWorkbook.Sheets(iWKSResult).Columns(1), _
ActiveWorkbook.Sheets(iActiveSheet).Cells(iRow, iColSeek)) = 0 Then
Sheets(iWKSResult).Cells(iRow2, 1).Value = _
ActiveWorkbook.Sheets(iActiveSheet).Cells(iRow, iColSeek).Value
Sheets(iWKSResult).Cells(iRow2, 2).Value = iAnzahl
Sheets(iWKSResult).Cells(iRow2, 3).Value = _
ActiveWorkbook.Sheets(iActiveSheet).Cells(iRow, iColExtra).Value
iRow2 = iRow2 + 1
End If
Else
With Sheets(iWKSResult)
.Cells(iRow2, 1).Value = _
ActiveWorkbook.Sheets(iActiveSheet).Cells(iRow, iColSeek).Value
.Cells(iRow2, 2).Value = iAnzahl
.Cells(iRow2, 3).Value = _
ActiveWorkbook.Sheets(iActiveSheet).Cells(iRow, iColExtra).Value
End With
iRow2 = iRow2 + 1
End If
frmChoice.txtDataRest.Enabled = True
If iDataAll Mod 5 = 0 Then
frmChoice.txtDataRest.Value = iDataAll
frmChoice.Repaint
End If
iDataAll = iDataAll - 1
Next iRow