2017-01-19 48 views
1

嗨,我重用这是在公布如下另一个活动问题共享代码 - 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 
+0

您是否尝试过更改表示'TextQualifier:= xlDoubleQuote'的代码?我不确定默认设置是什么,但是您可以将其更改为“TextQualifier:= xlTextQualifierNone”。 –

+0

我做了这个改变,但没有奏效。我在第一列有16位数字,例如,如果我有1234567891234567 excel显示它为1.23457E + 15和公式栏用0替换最后一位数字。 –

回答

0

试试这个(我没有)。它(希望)将工作表中的所有单元格设置为文本。见增加评论部分。

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 
+0

使用上面的代码,但它没有工作。我在第一列有16位数字,例如如果我有1234567891234567 excel显示它为1.23457E + 15,并且公式栏用0代替最后一位。如果我右键单击并检查列的格式,它将显示为文本。我相信在将数据放入列后会改变格式,在这种情况下,已经杂乱无章的16位数字格式数据不会变回文本 –

0

不是永久的解决方案,但我添加下面的改变看起来像解决了我的问题。由于我的一个文件中最长的记录有45个单元格,我自动记录在宏的下方,并在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 
相关问题