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

  

posted @ 2017-07-07 19:35  wangway  阅读(218)  评论(0编辑  收藏  举报