VBA Excel 列拆分

来源:互联网 发布:斗罗大陆3龙王传说淘宝 编辑:程序博客网 时间:2024/05/20 10:11

本人初次学习所写,有不好的地方还请指教

'    列拆分,并按照“|”来拆分,如果某列表头中包含“|”则进行拆分,否则不进行拆分

'    【数据替换数值版】中的数据Copy到该Sheet中
    Dim cSplit As Integer, cSplitName As String, stNewColumnsSplit As Worksheet
    
    Application.StatusBar = "正在处理列拆分"
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    stReplaceTextVersion.Activate
    stReplaceTextVersion.Copy After:=stReplaceTextVersion
    Set stNewColumnsSplit = ActiveSheet
    stNewColumnsSplit.Name = "列拆分" 'stConfigColumnsSplit.Name
    For cSplit = 1 To stNewColumnsSplit.UsedRange.Columns.Count
        cSplitName = stNewColumnsSplit.UsedRange.Cells(1, cSplit)
        If InStr(cSplitName, "|") > 0 Then
            stNewColumnsSplit.Columns(cSplit).Offset(, 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove '该列的右侧插入一列
            stNewColumnsSplit.Columns(cSplit + 1).Offset.Interior.Color = xlNone
            stNewColumnsSplit.Columns(cSplit).Select '选中需要拆分的列,然后进行拆分
            Selection.TextToColumns Destination:=Columns(cSplit), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
            stNewColumnsSplit.UsedRange.Cells(1, cSplit + 1).Interior.Color = stNewColumnsSplit.UsedRange.Cells(1, cSplit).Interior.Color
        End If
    Next cSplit
    stNewColumnsSplit.UsedRange.Font.Name = "Arial"  '设置该Sheet字体样式
    stNewColumnsSplit.Cells.EntireColumn.AutoFit
    stNewColumnsSplit.UsedRange.Select
    
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
0 0
原创粉丝点击