20161210xlVBA一行数据转为四行

时间:2023-03-08 15:39:29
20161210xlVBA一行数据转为四行
Sub NextSeven_CodeFrame()
'应用程序设置
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual '错误处理
On Error GoTo ErrHandler '计时器
Dim StartTime, UsedTime As Variant
StartTime = VBA.Timer '变量声明
Dim Wb As Workbook
Dim Sht As Worksheet
Dim Rng As Range
Dim OneCell As Range
Dim CellText As String
Dim Arr As Variant '实例化对象
Set Wb = Application.ThisWorkbook
Set Sht = Wb.Worksheets(1) With Sht
Set Rng = .Range("C9:ILH9")
For Each OneCell In Rng.Cells
CellText = Replace(OneCell.Text, " ", "")
CellText = Replace(CellText, " ", "")
CellText = Replace(CellText, ",", ",")
If Len(CellText) <> 0 Then
Arr = Split(CellText, ",")
For i = LBound(Arr) To UBound(Arr)
OneCell.Offset(i + 1).Value = Arr(i)
Next i
End If
Next OneCell
End With '运行耗时
UsedTime = VBA.Timer - StartTime
MsgBox "本次运行耗时:" & Format(UsedTime, "0.0000000秒") ErrorExit: '错误处理结束,开始环境清理
Set Wb = Nothing
Set Sht = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrHandler:
If Err.Number <> 0 Then
MsgBox Err.Description & "!", vbCritical, "错误提示!"
'Debug.Print Err.Description
Err.Clear
Resume ErrorExit
End If
End Sub