Option
Explicit
Private
Const
GC_INIT_NAME
As
String
=
"procInit"
Private
Const
GC_RESET_NAME
As
String
=
"procReset"
Public
Sub
prcDeleteRowCol()
Const
START_ROW
As
Long
= 2
Const
START_COLUMN
As
Long
= 2
Const
STEP_DECR
As
Long
= 10
Dim
lngLastColumn
As
Long
, lngLastRow
As
Long
, _
lngModRows
As
Long
, lngModColumns
As
Long
, lngIndex
As
Long
Dim
strPrompt
As
String
, strPrompt2
As
String
Dim
enmMsgBoxResult
As
VbMsgBoxResult
Dim
objName
As
Name
strPrompt =
"Es wurden bereits Zeilen u. Spalten gelöscht."
& vbCr & _
"Wenn Sie neue Ausgangsdaten einfügen, müssen sie 'prcReset' ausführen, "
& _
"um erneut den Löschvorgang ausführen zu können."
strPrompt2 =
"Es wurde 'prcReset' ausgeführt!"
& vbCr & _
"Möchten Sie wirklich Spalten und Zeilen von neuen Daten löschen?"
Application.ScreenUpdating =
False
With
ActiveSheet
For
Each
objName
In
.Names
If
objName.Name = .Name &
"!"
& GC_INIT_NAME
Then
MsgBox Prompt:=strPrompt, Buttons:=vbExclamation:
Exit
Sub
ElseIf
objName.Name = .Name &
"!"
& GC_RESET_NAME
Then
objName.Delete
enmMsgBoxResult = MsgBox(Prompt:=strPrompt2, Buttons:=vbYesNo + vbQuestion)
Exit
For
End
If
Next
.Names.Add Name:=GC_INIT_NAME, RefersTo:=GC_INIT_NAME, Visible:=
False
If
enmMsgBoxResult <> vbNo
Then
lngLastRow = .Cells(.Rows.Count, 1).
End
(xlUp).Row
lngLastColumn = .Cells(1, .Columns.Count).
End
(xlToLeft).Column
lngModRows = (lngLastRow - START_ROW + 1)
Mod
STEP_DECR
lngModColumns = (lngLastColumn - START_COLUMN + 1)
Mod
STEP_DECR
.Range(.Rows(lngLastRow - lngModRows + 1), .Rows(lngLastRow)).Delete
For
lngIndex = lngLastRow - lngModRows - 1
To
START_ROW + 1
Step
-STEP_DECR
.Range(.Rows(lngIndex - STEP_DECR + 2), .Rows(lngIndex)).Delete
Next
.Range(.Columns(lngLastColumn - lngModColumns + 1), .Columns(lngLastColumn)).Delete
For
lngIndex = lngLastColumn - lngModColumns - 1
To
START_COLUMN + 1
Step
-STEP_DECR
.Range(.Columns(lngIndex - STEP_DECR + 2), .Columns(lngIndex)).Delete
Next
End
If
End
With
End
Sub
Public
Sub
prcReset()
Dim
objName
As
Name
With
ActiveSheet
For
Each
objName
In
.Names
With
objName
If
.Name = ActiveSheet.Name &
"!"
& GC_INIT_NAME
Then
_
.Delete
End
With
Next
.Names.Add Name:=GC_RESET_NAME, RefersTo:=GC_RESET_NAME, Visible:=
False
End
With
End
Sub