Question

所以我一直在试图找到应该是基本文件组合的答案。我生成了几周的CSV文件。我需要将文件合并到一个堆叠数据的工作表中原始文件有2个日期和时间组合的列（d / mm / yyyy h：mm：ss）

我的VBA代码根据需要组合了数据，但时间格式化在主文件中（d / mm / yyyy h：mm）

有人可以帮助我使用我的代码：（

            Option Explicit


            Sub ImportCSVsWithReference()
            'Summary:   Import all CSV files from a folder into a single sheet
            '           adding a field in column A listing the CSV filenames

            Dim wbCSV   As Workbook
            Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("MasterCSV")
            Dim fCSV    As String
            Dim fList As String
            Dim fName As String
            Dim fd As FileDialog
            Dim FileChosen As Integer
            Dim FileName As String
            Dim i As Integer
            Dim wbCSVDisplayOrder As Long
            Dim M As Long



                                                        'Select the correct files for merge

            Set fd = Application.FileDialog(msoFileDialogFilePicker)

            'use the standard title and filters, but change the
            'initial folder
                    fd.InitialFileName = "C:\RTVis\OT"
                    fd.InitialView = msoFileDialogViewList
            'allow multiple file selection
                    fd.AllowMultiSelect = True
                    FileChosen = fd.Show
                    If FileChosen = -1 Then
            'open each of the files chosen
                    For i = 1 To fd.SelectedItems.Count
                    Workbooks.Open fd.SelectedItems(i)
            Next i
            End If

                                                        'clear master page of previous data

            If MsgBox("Clear the existing MasterCSV sheet before importing?", vbYesNo, "Clear?") _
                = vbYes Then wsMstr.UsedRange.Clear

            Application.ScreenUpdating = False  'speed up macro

                                                        'Combine files

            'start the CSV file listing
            fCSV = Dir(fName & "*.csv")


                Do While Len(fCSV) > 0
                  'open a CSV file
                    Set wbCSV = Workbooks.Open(fName & fCSV)

                  'copy date into master sheet and close source file
                    ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(0)
                    wbCSV.Close False
                  'ready next CSV
                    fCSV = Dir
                Loop

            Application.ScreenUpdating = True
            End Sub

Answer 1

如果我理解正确，您的问题在于打开文件时Excel的日期/时间格式，但解析工作正常。

当Excel看到类似日期的内容时，它会尝试根据您的Windows区域设置进行解释。因此，如果文件中的日期为DMY，并且您的设置为MDY，则日期将无法正确解释。

解决方法1：更改Windows区域设置以匹配CSV文件中的设置
解决方法2：使用QueryTables方法。您可以使用宏录制器并从本机Excel执行Data ► Get External Data ► From Text Files来获得VBA等效项。这将允许指定日期格式。但是你必须小心不要多次添加它们，而是通过刷新它们或者先删除它们然后再添加它们。
解决方法3：编写自己的解析例程来解析原始数据。如果这样做，可能应该使用FileSystemObject。
解决方法4：将文件后缀更改为.csv以外的其他内容，然后使用OpenText方法。这需要对现有代码进行最少的更改。您创建一个新文件;进口;然后删除它。下面的代码演示了这个过程，但没有做你想要的其他事情。

如果您使用4，则应添加一些错误处理，以防文件复制/删除过程出错。我最喜欢的选择是2或3。

示例代码

Option Explicit
Sub foo()
    Dim WB As Workbook, wbCSV As Workbook, swbCSV As String
    Dim sFN As String, sCopyFN
    Dim FD As FileDialog

Set WB = ThisWorkbook
Set FD = Application.FileDialog(msoFileDialogFilePicker)

With FD
    .AllowMultiSelect = False
    .Filters.Add "Text or CSV", "*.txt, *.csv", 1
    .Show
    sFN = .SelectedItems(1)
End With

'If CSV, remove suffix
sCopyFN = ""
If sFN Like "*.csv" Then
    sCopyFN = Left(sFN, Len(sFN) - 4)
    FileCopy sFN, sCopyFN
    sFN = sCopyFN
End If

Workbooks.OpenText Filename:=sFN, DataType:=xlDelimited, origin:=437, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
        FieldInfo:=Array(Array(1, xlDMYFormat), Array(2, xlGeneralFormat))

Set wbCSV = ActiveWorkbook

'Get path as string since it will not be available after closing the file
swbCSV = wbCSV.FullName

'Move the data into this workbook
Dim rCopy As Range, rDest As Range

With WB.Worksheets("sheet1")
    Set rDest = .Cells(.Rows.Count, 1).End(xlUp)
End With
Set rCopy = wbCSV.Sheets(1).UsedRange

rCopy.Copy rDest

'must close the file before deleting it
wbCSV.Close False
Kill swbCSV

End Sub

将多个CSV文件组合到单个工作表中，以维护日期时间格式

1 个答案:

示例代码