使用VBA将日期从.csv复制到.xlsx时,会交换日和月。

huangapple go评论71阅读模式
英文:

Using VBA to copy dates from a .csv to a .xlsx switches the day and month

问题

我在Excel中使用VBA有很多经验,但我在一个看似简单的问题上遇到了困难:

我有大量的.csv文件,我想要将这些数据汇总到一个.xlsx文件中。数据是日期和时间的列表,位于A列,然后是相应的数字在B和C列。我使用下面的代码逐个打开每个.csv文件,复制相关数据并粘贴到.xlsx文件中。

问题是,当我粘贴数据时,Excel会交换日期和月份,对于每个月的1到12号的日期(例如,02/01/2023变成了01/02/2023),甚至在.csv文件中也发生了变化。我知道日期格式可能会导致问题,但它在我复制的文件中发生变化真的让我感到困惑。

为了尝试解决这个问题,我在粘贴操作之前和之后将我的日期列的格式更改为与.csv文件相匹配(自定义:“dd/mm/yyyy hh:mm”),但没有效果。我还尝试了直接复制粘贴与粘贴值之间的区别,但没有任何不同。我还尝试了循环遍历范围中的每个单元格,使用xlsCell.value = csvCell.value,但仍然得到相同的结果。

以下是我的代码:

Sub collateData()

Dim StrFile As String
Dim wb As Workbook, swb As Workbook
Dim sht As Worksheet
Dim pasteRow As Integer, headerRowCount As Integer, count As Integer

headerRowCount = 8
pasteRow = headerRowCount + 1

Set wb = Workbooks.Open(ThisWorkbook.Path & "/Member ID - LJW6127 - collated.xlsx")

StrFile = Dir("C:\Users\me\OneDrive\Member Id - LJW61Z7\*.csv")

Do While Len(StrFile) > 0

    If Len(StrFile) = 26 Then

        Set swb = Workbooks.Open("C:\Users\me\OneDrive\Member Id - LJW61Z7\" & StrFile)

        Set sht = swb.Sheets(1)

        wb.Sheets("Hourly").Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"

        sht.Range("A9:C" & sht.UsedRange.Rows.Count).Copy
        wb.Sheets("Hourly").Range("A" & pasteRow).PasteSpecial xlPasteValues

        pasteRow = pasteRow + sht.UsedRange.Rows.Count - headerRowCount

        Application.DisplayAlerts = False
        swb.Close
        Application.DisplayAlerts = True

        DoEvents

        Application.CutCopyMode = False

    End If

    StrFile = Dir

Loop

wb.Sheets("Hourly").Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"

End Sub

非常感谢您的帮助,提前致以感谢!

英文:

I have a lot of experience with using VBA in Excel but I'm really struggling with something that feels like it should be straight forward:

I have a large number of .csv files and I would like to collate the data into one .xlsx file. The data is a list of dates and time in column A and then corresponding figures in columns B and C. I'm using the code below to open each .csv one at a time, copy the relevant data and paste it into the .xlsx.

The problem is that when I paste the data, Excel is swapping the day and month for days 1 to 12 of the month (e.g. 02/01/2023 becomes 01/02/2023), IT IS EVEN CHANGING THEM IN THE .CSV. I know there can be issues with date formats but the fact that it is changing in the file I am copying FROM has really baffled me.

In an attempt to fix this I am changing the format of my dates column to match that of the .csv (CUSTOM: "dd/mm/yyyy hh:mm") before and after the paste operation, but to no avail. I've also tried a straight copy paste vs pasteValues and it doesn't make any difference. I've also tried looping through each cell in the range and using xlsCell.value = csvCell.value, but I still get the same result.

Here is my code:

Sub collateData()

Dim StrFile As String
Dim wb As Workbook, swb As Workbook
Dim sht As Worksheet
Dim pasteRow As Integer, headerRowCount As Integer, count As Integer

headerRowCount = 8
pasteRow = headerRowCount + 1

Set wb = Workbooks.Open(ThisWorkbook.Path & "/Member ID - LJW6127 - collated.xlsx")

StrFile = Dir("C:\Users\me\OneDrive\Member Id - LJW61Z7\*.csv")

Do While Len(StrFile) > 0

    If Len(StrFile) = 26 Then
        
        Set swb = Workbooks.Open("C:\Users\me\OneDrive\Member Id - LJW61Z7\" & StrFile)
        
        Set sht = swb.Sheets(1)
        
        wb.Sheets("Hourly").Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"
        
        sht.Range("A9:C" & sht.UsedRange.Rows.count).Copy
        wb.Sheets("Hourly").Range("A" & pasteRow).PasteSpecial xlPasteValues
        
        pasteRow = pasteRow + sht.UsedRange.Rows.count - headerRowCount
            
        Application.DisplayAlerts = False
        swb.Close
        Application.DisplayAlerts = True
        
        DoEvents
        
        Application.CutCopyMode = False
    
    End If
    
    StrFile = Dir
    
Loop
        
wb.Sheets("Hourly").Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"

End Sub

Any help would be greatly appreciated, thank you in advance!

答案1

得分: 1

尝试 OpenText 方法

Option Explicit

Sub collateData()

    Const HDR = 8
    Const CSVFOLDER = "C:\Users\me\OneDrive\Member Id - LJW61Z7\"
    Const TARGET = "Member ID - LJW6127 - collated.xlsx"

    Dim wb As Workbook, rng As Range, ar
    Dim lastRow As Long, n As Long, StrFile As String
    
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & TARGET)
    With wb.Sheets("Hourly")
        .Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"
        Set rng = .Cells(HDR + 1, "A")
    End With
    
    StrFile = Dir(CSVFOLDER & "*.csv")
    Application.ScreenUpdating = False
    Do While Len(StrFile) > 0
    
        If Len(StrFile) = 26 Then
            
            Workbooks.OpenText Filename:=CSVFOLDER & StrFile, Origin:=xlWindows, _
               DataType:=xlDelimited, Comma:=True, local:=True, _
               FieldInfo:=Array(Array(0, 4), Array(1, 1), Array(2, 1))
            
            With ActiveWorkbook.Sheets(1)
                lastRow = .Cells(.Rows.count, "A").End(xlUp).Row
                ' 复制到数组
                ar = .Range("A" & HDR + 1 & ":C" & lastRow)
                ActiveWorkbook.Close False
            End With
            
            ' 更新数值
            rng.Resize(UBound(ar), UBound(ar, 2)) = ar
            Set rng = rng.Offset(UBound(ar))
            n = n + 1
            
        End If
        StrFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox n & " 个 CSV 文件已导入", vbInformation

End Sub
英文:

Try OpenText method

Option Explicit

Sub collateData()

    Const HDR = 8
    Const CSVFOLDER = "C:\Users\me\OneDrive\Member Id - LJW61Z7\"
    Const TARGET = "Member ID - LJW6127 - collated.xlsx"

    Dim wb As Workbook, rng As Range, ar
    Dim lastRow As Long, n As Long, StrFile As String
    
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & TARGET)
    With wb.Sheets("Hourly")
        .Columns(1).NumberFormat = "dd/mm/yyyy hh:mm"
        Set rng = .Cells(HDR + 1, "A")
    End With
    
    StrFile = Dir(CSVFOLDER & "*.csv")
    Application.ScreenUpdating = False
    Do While Len(StrFile) > 0
    
        If Len(StrFile) = 26 Then
            
            Workbooks.OpenText Filename:=CSVFOLDER & StrFile, Origin:=xlWindows, _
               DataType:=xlDelimited, Comma:=True, local:=True, _
               FieldInfo:=Array(Array(0, 4), Array(1, 1), Array(2, 1))
            
            With ActiveWorkbook.Sheets(1)
                lastRow = .Cells(.Rows.count, "A").End(xlUp).Row
                ' copy to array
                ar = .Range("A" & HDR + 1 & ":C" & lastRow)
                ActiveWorkbook.Close False
            End With
            
            ' update values
            rng.Resize(UBound(ar), UBound(ar, 2)) = ar
            Set rng = rng.Offset(UBound(ar))
            n = n + 1
            
        End If
        StrFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox n & " csv files imported", vbInformation

End Sub

</details>



huangapple
  • 本文由 发表于 2023年3月8日 19:39:51
  • 转载请务必保留本文链接:https://go.coder-hub.com/75672562.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定