2017-01-19 47 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 
相關問題