Sub T_358()
Dim lngI As Long, intI As Integer, arrSIn, arrSOut(), objC As Range, strS As String
For lngI = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
strS = Cells(lngI, 6)
Select Case InStr(1, strS, Chr(10))
Case 0
If Not strS = "" And InStr(1, strS, "-") > 0 Then
Cells(lngI, 6) = Trim(Mid(strS, InStr(1, strS, "-") + 1, Len(strS) - InStr(1, strS, "-")))
ElseIf Not strS = "" And InStr(1, strS, "-") = 0 Then
Cells(lngI, 6) = Mid(strS, InStr(1, strS, " ") + 1, Len(strS) - InStr(1, strS, " "))
End If
Case Is > 0
arrSIn = Split(Cells(lngI, 6), Chr(10))
For intI = UBound(arrSIn) To 0 Step -1
If intI > 0 Then
Rows(lngI + 1).Insert shift:=xlDown
Cells(lngI + 1, 1) = Cells(lngI, 1): Cells(lngI + 1, 2) = Cells(lngI, 2)
Cells(lngI + 1, 3) = Cells(lngI, 3): Cells(lngI + 1, 4) = Cells(lngI, 4)
If InStr(1, arrSIn(intI), "-") > 0 Then
Cells(lngI + 1, 5) = Trim(Split(arrSIn(intI), "-")(0))
Cells(lngI + 1, 6) = Trim(Split(arrSIn(intI), "-")(1))
ElseIf InStr(1, arrSIn(intI), " ") > 0 Then
Cells(lngI + 1, 5) = Trim(Split(arrSIn(intI), " ")(0))
Cells(lngI + 1, 6) = Trim(Mid(arrSIn(intI), InStr(1, arrSIn(intI), " "), _
Len(arrSIn(intI)) - InStr(1, arrSIn(intI), " ")))
End If
Else
If InStr(1, arrSIn(intI), "-") > 0 Then
Cells(lngI, 5) = Trim(Split(arrSIn(intI), "-")(0))
Cells(lngI, 6) = Trim(Split(arrSIn(intI), "-")(1))
ElseIf InStr(1, arrSIn(intI), " ") > 0 Then
Cells(lngI, 5) = Split(arrSIn(intI), " ")(0)
Cells(lngI, 6) = Trim(Mid(arrSIn(intI), InStr(1, arrSIn(intI), " "), _
Len(arrSIn(intI)) - InStr(1, arrSIn(intI), " ")))
End If
End If
Next intI
End Select
Next lngI
End Sub
|