嗨,我重用这是在公布如下另一个活动问题共享代码 - Import Multiple text files into workbook where worksheet name matches text file nameExcel的VBA - 导入多个TXT文件,但无法将数据转换为文本格式
此代码工作完美的我创建和多个工作表并将管道分隔的数据导入到各个列中。我遇到的问题是我需要将所有单元格设置为文本限定,然后才将文本设置为列。基本上,我希望所有的列都是文本格式,而不是默认的常规,因为我在文件中的16位数字正在使用常规格式。我确实尝试了下面几行,但它改变了文本到列完成后的格式。
cells.select
Selection.NumberFormat = "@"
任何帮助获取文本格式的所有数据将不胜感激。这里是我使用的代码
Sub Extract()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
sDelimiter = "|"
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
Set wkbAll = Application.ActiveWorkbook
x = 1
With Workbooks.Open(Filename:=FilesToOpen(x))
.Worksheets(1).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="|"
.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
.Close False
End With
x = x + 1
While x <= UBound(FilesToOpen)
With Workbooks.Open(Filename:=FilesToOpen(x))
.Worksheets(1).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter
.Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End With
x = x + 1
Wend
wkbAll.Save
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
您是否尝试过更改表示'TextQualifier:= xlDoubleQuote'的代码?我不确定默认设置是什么,但是您可以将其更改为“TextQualifier:= xlTextQualifierNone”。 –
我做了这个改变,但没有奏效。我在第一列有16位数字,例如,如果我有1234567891234567 excel显示它为1.23457E + 15和公式栏用0替换最后一位数字。 –