Excel VBA – 导入多个txt文件，但不能将数据转换为文本格式

您好我正在重复使用在另一个活跃的问题中发布的代码，如下所示 – 将多个文本文件导入工作簿，其中工作表名称与文本文件名称匹配

这段代码对于创build和多个工作表以及将pipe道分隔的数据导入到各个列中是完美的。 我遇到的问题是我需要将所有单元格设置为文本限定，然后将文本设置为列。 基本上我想所有的列都是文本格式，而不是默认的一般，因为我在我的文件中有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 

Answer 1

试试这个（我没有）。 它（希望）将工作表中的所有单元格设置为文本。 随着看到评论部分的增加。

 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).Cells.NumberFormat = "@" ' --------------------------------------------------- .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 

Answer 2

不是永久的解决scheme，但我添加下面的改变看起来像解决了我的问题。 由于在我的一个文件中最长的logging有45个单元格我自动logging下面的macros，并附加到我的代码之后OtherChar：=“|” 现在它正在按我的意图工作。

 OtherChar:="|", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _ 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12 _ , 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), _ Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array( _ 25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), Array(31, 2), _ Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2), Array(36, 2), Array(37, 2), Array( _ 38, 2), Array(39, 2), Array(40, 2), Array(41, 2), Array(42, 2), Array(43, 2), Array(44, 2), _ Array(45, 2)), TrailingMinusNumbers:=True