' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub splitLines()
Dim lngRow As Long, lngLast As Long
Dim intFirst As Integer, intLast As Integer, intInsert As Long, intR As Integer
On Error GoTo ErrExit
tranquilize
With ActiveSheet
lngLast = Application.Max(4, .Cells(.Rows.Count, 1).End(xlUp).Row)
For lngRow = lngLast To 4 Step -1
If InStr(1, .Cells(lngRow, 3), "-") > 0 Then
intFirst = Split(.Cells(lngRow, 3), "-")(0)
intLast = Split(.Cells(lngRow, 3), "-")(1)
intInsert = intLast - intFirst
.Range(.Cells(lngRow + 1, 1), .Cells(lngRow + intInsert, 1)).EntireRow.Insert
intInsert = 0
For intR = intFirst To intLast
.Rows(lngRow + intInsert).Value = .Rows(lngRow).Value
.Cells(lngRow + intInsert, 3) = intR
intInsert = intInsert + 1
Next
End If
Next
End With
ErrExit:
tranquilize True
End Sub
Public Sub tranquilize(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
If Modus Then
With Err
If .Number <> 0 Then
MsgBox IIf(Erl, vbLf & "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbLf & _
.Description, vbExclamation, "Fehler"
End If
.Clear
End With
End If
End Sub