Public
Sub
aaa()
Dim
ws
As
Worksheet,
Application.ScreenUpdating =
False
For
Each
ws
In
ThisWorkbook.Sheets
Select
Case
ws.Name
Case
"EBewertung"
,
"Risikoauswertung"
With
ws
lLetzte = .Cells(.Rows.Count, 7).
End
(xlUp).Row
For
lZeile = 1
To
6
.Columns(
"G"
).Insert Shift:=xlToRight
Next
lZeile
.Columns(
"G:L"
).NumberFormat =
"@"
.Range(
"G2:L"
& lLetzte) = 0
For
lZeile = 1
To
lLetzte
aTemp = Split(.Cells(lZeile, 13),
"."
)
For
iIndx = 0
To
UBound(aTemp)
If
IsNumeric(aTemp(iIndx))
And
Len(aTemp(iIndx)) < 2
Then
.Cells(lZeile, 7 + iIndx) =
"00"
& aTemp(iIndx)
ElseIf
Len(aTemp(iIndx)) < 3
Then
.Cells(lZeile, 7 + iIndx) =
"0"
& aTemp(iIndx)
Else
.Cells(lZeile, 7 + iIndx) = aTemp(iIndx)
End
If
Next
iIndx
Next
lZeile
.Range(
"G2:Z"
& lLetzte).Sort Key1:=.Range(
"J2"
), Order1:=xlAscending, _
Key2:=.Range(
"K2"
), Order2:=xlAscending, Key3:=.Range(
"L2"
), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=
False
, Orientation:=xlTopToBottom
.Range(
"G2:Z"
& lLetzte).Sort Key1:=.Range(
"G2"
), Order1:=xlAscending, _
Key2:=.Range(
"H2"
), Order2:=xlAscending, Key3:=.Range(
"I2"
), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=
False
, Orientation:=xlTopToBottom
.Columns(
"G:L"
).Delete Shift:=xlToLeft
End
With
Case
Else
End
Select
Next
ws
Application.ScreenUpdating =
True
End
Sub