将 CSV 文件导入 Excel，然后以正确的格式保存以导入 SAGE One Accounting

Question

当前 CSV 文件有 A 到 H 列，如下所示：

现在我想使用VBA Excel和Active X Control Button仅按顺序导入B、E、D、F列，我还想连接E和D，它还需要从第4行开始导入并需要停止在最后一行之前。它需要添加标题 Date 、 Description 和 Amount 。现在我遇到的大问题是，CSV 文件中的日期列，即 B 列，它是 YYYYDDMM，我需要它位于 dd/mm/yyyy 中，否则它不会导入到 Sage One Accounting 中。

这是我的尝试：

Private Sub btnImportData_Click()
    Dim vR(), vDB
    Dim WbCSV As Workbook, Wb As Workbook
    Dim Ws As Worksheet
    Dim i As Long, n As Integer
    Dim vFile As Variant

    Application.ScreenUpdating = False
    Set Wb = ThisWorkbook
    Set Ws = Wb.Sheets(2)

    'Select a text file through the file dialog.
    'Get the path and file name of the selected file to the variable.
    vFile = Application.GetOpenFilename("ExcelFile *.txt,*.txt;*.csv", _
        Title:="Select CSV file", MultiSelect:=False)

    'If you don't select a file, exit sub.
    If TypeName(vFile) = "Boolean" Then
        Application.ScreenUpdating = True
        Exit Sub
    End If

    'The selected text file is imported into an Excel file. format:2 is csv, format:1 is tab
    Set WbCSV = Workbooks.Open(Filename:=vFile, Format:=2)

    'Bring all the contents of the sheet into an array.
    With WbCSV.Sheets(1)
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        If lastRow < 4 Then Exit Sub ' If last row is less than 4, exit sub
        vDB = .Range("B4:H" & lastRow).Value

        For i = 1 To UBound(vDB, 1)
            ' Adjust column numbers as needed
            n = n + 1
            ReDim Preserve vR(1 To 4, 1 To n)
            ' Convert yyyymmdd format to dd/mm/yyyy format
            vR(1, n) = ConvertDateFormat(vDB(i, 1))
            vR(2, n) = vDB(i, 5) ' Column E
            vR(3, n) = vDB(i, 6) ' Column F
            vR(4, n) = vDB(i, 4) ' Column D
        Next i
    End With

    'Close the text file
    WbCSV.Close (0)

    'The dynamic array is recorded in sheet2. Bring the row to the inverted state.
    With Ws
        .UsedRange.Clear
        .Range("a1").Resize(n, 4).Value = WorksheetFunction.Transpose(vR)
    End With

    Worksheets("Sheet2").Columns("A:D").AutoFit
    Application.ScreenUpdating = True
End Sub

Private Function ConvertDateFormat(dateValue As Variant) As Variant
    ' Convert yyyymmdd format to dd/mm/yyyy format
    If Len(dateValue) = 8 Then
        ConvertDateFormat = Format(DateSerial(Left(dateValue, 4), Mid(dateValue, 5, 2), Right(dateValue, 2)), "dd/mm/yyyy")
    Else
        ConvertDateFormat = dateValue ' Return original value if not in expected format
    End If
End Function

使用此代码，我导入了不正确的列，并且日期格式不正确，例如 CSV 中的格式是 20231002，它应该转换为 02/10/2023，而不是将其转换为 10/02/2023。下面是当我单击导入按钮时我想要的图像

Answer 1

在将数组写入工作表之前，将 A 列格式设置为 dd/mm/yyyy。

Option Explicit

Private Sub btnImportData_Click()
    Dim vFile, arIn, arOut()
    Dim wbCSV As Workbook
    Dim i As Long, lastRow As Long, s As String
    Dim t0 As Single

    'Select a text file through the file dialog.
    'Get the path and file name of the selected file to the variable.
    vFile = Application.GetOpenFilename("ExcelFile *.txt,*.txt;*.csv", _
        Title:="Select CSV file", MultiSelect:=False)

    'If you don't select a file, exit sub.
    If TypeName(vFile) = "Boolean" Then
        Application.ScreenUpdating = True
        Exit Sub
    End If
    t0 = Timer

    'The selected text file is imported into an Excel file. format:2 is csv, format:1 is tab
    Set wbCSV = Workbooks.Open(Filename:=vFile, Format:=2, ReadOnly:=True)

    'Bring all the contents of the sheet into an array
    'and close the text file
    With wbCSV.Sheets(1)
        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        If lastRow < 4 Then Exit Sub ' If last row is less than 4, exit sub
        arIn = .Range("B4:H" & lastRow).Value
        
        wbCSV.Close
    End With
    
    'built output array from input array
    ReDim Preserve arOut(1 To UBound(arIn), 1 To 3)
    For i = 1 To UBound(arIn, 1)
        ' Adjust column numbers as needed
        s = Trim(arIn(i, 1))
        If Len(s) <> 8 Then
            MsgBox s & " date error", vbCritical
            Exit Sub
        End If
        arOut(i, 1) = DateSerial(Left(s, 4), Mid(s, 5, 2), Right(s, 2))
        arOut(i, 2) = arIn(i, 4) & " " & arIn(i, 5) ' Column E&F
        arOut(i, 3) = arIn(i, 6) ' Column G
    Next

    'write output array to sheet2
    With ThisWorkbook.Sheets(2)
        .UsedRange.Clear
        .Range("A1:C1") = Array("Date", "Description", "Amount")
        .Range("A:A").NumberFormat = "dd/mm/yyy"
        .Range("B:B").NumberFormat = "@"
        .Range("C:C").NumberFormat = "#,##0.00"
        .Range("A2").Resize(UBound(arOut), 3).Value = arOut
        .Columns("A:C").AutoFit
    End With
    MsgBox "Done", vbInformation, Format(Timer - t0, "0.0 secs")

End Sub