嗨,我重用這是在公佈如下另一個活動問題共享代碼 - 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替換最後一位數字。 –