Option
Explicit
Sub
ChkIt()
Dim
rngCol
As
Excel.Range, rngTxt
As
Excel.Range, rngArea
As
Excel.Range
Dim
rngNmb
As
Excel.Range, rngChk
As
Excel.Range
On
Error
GoTo
ChkIt_Error
Set
rngCol = Range(Cells(1, 2), Cells(Rows.Count, 2).
End
(xlUp))
If
rngCol.Cells.Count > 1
Then
If
IsNumeric(rngCol.Cells(1))
Then
Set
rngTxt = rngCol.SpecialCells(xlCellTypeConstants, 2)
For
Each
rngArea
In
rngTxt.Areas
Set
rngNmb = rngArea.Cells(1).Offset(-1)
Set
rngChk = rngNmb.Offset(, -1)
Set
rngChk = rngChk.Resize(rngArea.Rows.Count + 1, 1)
rngChk = rngNmb
Next
rngArea
End
If
End
If
On
Error
GoTo
0
ChkIt_Error:
Select
Case
Err.Number
Case
Is
= 0
Set
rngChk = rngCol.Offset(, -1)
For
Each
rngNmb
In
rngChk
If
Len(rngNmb) = 0
And
IsNumeric(rngNmb.Offset(, 1))
Then
_
rngNmb = rngNmb.Offset(, 1)
Next
rngNmb
Case
Is
= 1004
Call
MsgBox(
"keine Texte in Spalte"
, vbCritical,
"Fehler"
)
Case
Else
Call
MsgBox(
"unbekannter Spaltenaufbau"
, vbCritical,
"Fehler"
)
End
Select
End
Sub