Question

我正在尝试将多个txt文件导入excel。该代码可以正常运行，但会弄乱日期和数字格式。例如，对于大于1000的数字，它省略零。我尝试了另一篇文章中描述的解决方案：Excel VBA - Importing multiple txt files but not able to convert data to text format使用FieldInfo来解决显示此类格式问题的列（第18、62、63、64、65列），但仍然无法正常工作。这是我正在使用的原始代码。

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:="|", FieldInfo:=Array(Array(18, 2), Array(62, 2), Array(63, 2), Array(64, 2), Array(65, 2)), TrailingMinusNumbers:=True
    .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, FieldInfo:=Array(Array(18, 2), Array(62, 2), Array(63, 2), Array(64, 2), Array(65, 2)), TrailingMinusNumbers:=True
        .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

更新我还找到了一个实际上可以解决数据格式错误的代码，但这仅用于导入1个文件。 我需要类似的东西，但要导入39个txt文件，所有文件都具有相同的结构：大约70列，其中大多数为字符串，除了3个数字和1个日期（这些最后一个导致麻烦）。有什么帮助吗？预先感谢。

Sub importCSV()

Dim ans As Integer:
ans = MsgBox("Click OK then select the file to import " & vbNewLine & "Data will be imported at position of active cell", vbOKCancel)
If ans = vbCancel Then
    GoTo exitpoint
End If
'data will be imported at position of active cell as first data element
Dim ColumnsType() As Variant
strFilepath = Application.GetOpenFilename() 'prompt user for filepath of import file
If strFilepath = False Then Exit Sub
Dim intFileNo As Integer
Dim nCol As Long
Dim strLine As String
Dim varColumnFormat As Variant
Dim varTemp As Variant

' Read first line of file to figure out how many columns there are
intFileNo = FreeFile()
Open strFilepath For Input As #intFileNo
Line Input #intFileNo, strLine
Close #intFileNo
varTemp = Split(strLine, ",")
nCol = UBound(varTemp)
ReDim varColumnFormat(0 To nCol)

' get the columns to import as Text from user
Dim textit() As String
textit = Split(InputBox("Enter columns to format as Text (e.g 1,3,5)" & Chr(10) & Chr(10) & "Or OK/Cancel to use file definition"), ",")
ub = UBound(textit)
If ub = -1 Then 'if nothing entered, promp for file for column formats
    Dim strFilename2 As String: strFilename2 = Application.GetOpenFilename()
    If strFilename2 = "" Or strFilename2 = "False" Then
        MsgBox "No column Types have been entered." & Chr(10) & "Exiting Sub.", vbExclamation
        Exit Sub
    End If
    Dim strFileContent As String
    Dim iFile As Integer: iFile = FreeFile
    Open strFilename2 For Input As #iFile
        strFileContent = Input(LOF(iFile), iFile)
    Close #iFile
    textit = Split(strFileContent, ",")
    ub = UBound(textit)
    If ub < nCol Then 'confirm there are enough column denoted in the file
        MsgBox "There are too few columns denoted in your column format file." & Chr(10) & "Exiting Sub.", vbExclamation
        Exit Sub
    End If
    For i = 0 To nCol 'assing the file values to the column format array
        varColumnFormat(i) = Int(textit(i))
    Next
Else 'assign the entered columns a Text format value in the column format array
    Dim uBi As Integer
    uBi = 0
    For i = 0 To nCol
        If i + 1 = textit(uBi) Then
            varColumnFormat(i) = xlTextFormat
            uBi = WorksheetFunction.Min(uBi + 1, ub)
        Else
            varColumnFormat(i) = xlGeneralFormat
       End If
    Next
End If
With ActiveWorkbook.ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFilepath, Destination:=ActiveCell)     'creates the query to import the CSV. All following lines are properties of this
.PreserveFormatting = False
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = True
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = Application.International(xlListSeparator) 'uses system setting => EU countries = ';' and US = ','
.TextFileColumnDataTypes = varColumnFormat  'set column data types as input by user
.Refresh BackgroundQuery:=False         'this is neccesary so a second import can be done
End With
ActiveWorkbook.ActiveSheet.QueryTables(1).Delete  'deletes the query
MsgBox "Date Import Done!"
exitpoint:
End Sub

Answer 1

您的问题是从文本文件中提取数据时的数据类型。您需要将18, 2更改为18, 1

Number Format
1      Text
2      General
3      I think this means skip?
4      Date

因此，您需要将FieldInfo:=Array(Array(18, 2), Array(62, 2), Array(63, 2), Array(64, 2), Array(65, 2))更改为所需的数据类型。文字最适合我认为 7 个数字的数字。在日期列中使用日期，但您需要检查其格式是否正确

所以，如果下面所有的都是数字，最后一个是日期，则看起来像这样

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, FieldInfo:=Array(Array(18, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 4)), TrailingMinusNumbers:=True
        .Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

导入多个txt文件的日期和数字格式错误

1 个答案: