excel - excel vba将csv文件的内容合并到新工作簿

Question

以下代码获取文件夹中的所有 csv 文件并将其内容合并到主文件中

Sub Consolidate()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
    Dim lastrow As Long, erow As Long, lngDstLastRow As Long, lngLastCol As Long, i As Integer
Dim wksDst As Worksheet
Set wksDst = ThisWorkbook.Worksheets("QA Master")


lngDstLastRow = LastOccupiedRowNumInCol(wksDst, 1)
lastrow = Worksheets("QA Master").Cells(Rows.Count, 1).End(xlUp).Row

lngLastCol = LastOccupiedColNumInRow(wksDst, 1)
'clears previous contents along with formatting

    If lngDstLastRow > 1 Then
        With wksDst
            .Range(.Cells(2, 1), .Cells(lngDstLastRow, lngLastCol)).ClearContents
            .Range(.Cells(2, 1), .Cells(lngDstLastRow, lngLastCol)).ClearFormats
        End With
    End If


    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from

    ThisWB = ActiveWorkbook.Name

    path = "Path to folder"

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.csv", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
        
        Filename = Dir()
    Loop

    Range("A1").Select

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ThisWorkbook.Save
    MsgBox "Update Done!"
End Sub
Public Function LastOccupiedRowNumInCol(Sheet As Worksheet, _
                                        ColNum As Long) As Long
    Dim lng
    If ColNum > 0 Then
        With Sheet
            lng = .Cells(.Rows.Count, ColNum).End(xlUp).Row
        End With
    Else
        lng = 0
    End If
    LastOccupiedRowNumInCol = lng
End Function

Public Function LastOccupiedColNumInRow(Sheet As Worksheet, _
                                        RowNum As Long) As Long
    Dim lng As Long
    If RowNum > 0 Then
        With Sheet
            lng = .Cells(RowNum, .Columns.Count).End(xlToLeft).Column
        End With
    Else
        lng = 0
    End If
    LastOccupiedColNumInRow = lng
End Function

除了日期列外，一切都按预期工作，某些日期的格式已更改（mm/dd/yy 而不是原始的 dd/mm/yy） 我尝试了 NumberFormat 但它没有帮助。其余的代码工作得很好。唯一的问题是某些日期格式已更改。在 csv 文件中输入的日期是统一的日期类型 (dd/mm/yy)。怎么可能只有部分日期被更改？任何见解表示赞赏。谢谢

Excel 数据示例

标签： excelvba