vbaformat_VBA 格式化excel数据表 （数据分列）

Sub ImportData()

'

' Copy Data from one workbook to the Current Workbook

' Place the macro file in the same folder as the source file

'

p = ThisWorkbook.Path & "\"

f = Dir(p & "*.xlsx")

Application.ScreenUpdating = False

thrn = ThisWorkbook.Sheets(1).Range("A100000").Row

With ThisWorkbook.Sheets(1)

.Range("A1:T" & thrn).ClearContents

End With

Do While f <> ""

If f <> ThisWorkbook.Name Then

Set wb = GetObject(p & f)

With wb.Sheets(1)

rn = .Range("A100000").End(xlUp).Row

ThisWorkbook.Sheets(1).Range("A1:T" & rn).Value = .Range("A1:T" & rn).Value

MsgBox "Format Complete."

End With

End If

f = Dir

Loop

End Sub

Sub Text_to_Columns()

'Formatted Data

Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _

Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _

:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _

1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _

, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 3), Array(17, 1), Array(18, 1), _

Array(19, 1), Array(20, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", _

TrailingMinusNumbers:=True

Columns("A:T").Select

Selection.Copy

End Sub

Sub Copy_Back()

'

' Copy back the formatted data to the source file

'

p = ThisWorkbook.Path & "\"

f = Dir(p & "*.xlsx")

Application.ScreenUpdating = False

thrn = ThisWorkbook.Sheets(1).Range("A100000").Row

Do While f <> ""

If f <> ThisWorkbook.Name Then

Set wb = GetObject(p & f)

With wb.Sheets(1)

rn = .Range("A100000").End(xlUp).Row

.Range("A1:T" & rn).ClearContents

.Range("A1:T" & thrn).Value = ThisWorkbook.Sheets(1).Range("A1:T" & thrn).Value

MsgBox "Complete."

End With

End If

f = Dir

Loop

ThisWorkbook.Sheets(1).Range("A1:T" & thrn).ClearContents

wb.Save 'Make sure the source file is already open

End Sub

Sub ExecConvert()

'

'Execute Macros

'

Call ImportData

Call Text_to_Columns

Call Copy_Back

End Sub

标签：ThisWorkbook,VBA,End,Sub,excel,数据表,Range,Sheets,Array

来源： https://www.cnblogs.com/luoye00/p/11358409.html