Question

我有一个简单的宏（作为我的工作簿中的一大堆其他内容的一部分），它将一个工作表中列的内容复制到另一个工作表中。此列是一组日期，存储为文本。问题是，对于所有日期少于12月的日期，它将当天作为月份，反之亦然。

这里和其他网站上有很多类似的主题，但没有一个真正奏效。我希望有一个简单的解决方案。

我最新版本的宏

Sub DateMacro()

Sheets("Output").Range("A2:A1048575").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"
Sheets("Input").Range("A2:A1048575").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"
Sheets("Output").Range("A2:A1048575").Value = Sheets("Input").Range("A2:A1048575").Value

End Sub

我已将示例工作簿here

关联起来

其他信息：
从报告系统导出时，我无法控制日期的格式，因此我需要在报告工作簿中进行更改。

更新：我和一位同事交谈过，他想出了这个：

Sub test()

Dim i As Long
Dim RngEnd As Long

Dim rng As String
Dim test As String

RngEnd = Range("A1").End(xlDown).Row

For i = 2 To RngEnd

rng = "A" & i
test = Sheets("Input").Range(rng).Value

Sheets("Output").Range(rng) = DateValue(test) + TimeValue(test)


Next i
End Sub

这似乎工作正常，但有一个弹出“错误13类型不匹配”。你能想到的任何想法或修正吗？

Answer 1

您可以遍历每个单元格，检查日期是否在1到12之间，然后使用DateSerial切换日期和月份。然后将它存储在一个数组中（以便更快地运行），最后，将整个数组转储到＆＃34;输出＆＃34;表格使用Application.Transpose。

代码注释中的更多解释。

<强> 代码

Option Explicit

Sub DateMacro()

Dim LastRow As Long, i As Long
Dim DateStr As String
Dim DatesArr() As Double

ReDim DatesArr(0)

With Sheets("Input")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column A

    For i = 2 To LastRow ' from 2nd row until last row with data
        ' === if day  is from 1 though 12 of the month comes "mm/dd/yyyy" >> switch month and day ===
        Select Case Day(.Range("A" & i).Value)
            Case 1 To 12
                DateStr = Format(.Range("A" & i).Value, "dd/mm/yyyy")

                ' switch month and day
                DatesArr(UBound(DatesArr)) = DateSerial(Year(DateValue(DateStr)), Day(DateValue(DateStr)), Month(DateValue(DateStr)))

            Case Else
                DatesArr(UBound(DatesArr)) = DateValue(.Range("A" & i).Value)

        End Select

        ReDim Preserve DatesArr(UBound(DatesArr) + 1) ' keep record and raise array index by 1
    Next i
End With

' resize array to actual populated size
ReDim Preserve DatesArr((UBound(DatesArr) - 1))

Sheets("Output").Range("A2:A" & LastRow).NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"

' use Application.Transpose to copy the entire array contents to your range
Sheets("Output").Range("A2:A" & LastRow).Value = Application.Transpose(DatesArr)

End Sub

Answer 2

我找到了适用于我的情况的东西。只是张贴以防其他人需要它。我只需要在传输数据之前将输出范围格式化为文本，然后将其转换回我想要的日期格式。

Sheets("Output").Range("A:A").NumberFormat = "@"
Sheets("Input").Range("A:A").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"
Sheets("Output").Range("A:A").Value = Sheets("Input").Range("A:A").Value
Sheets("Output").Range("A:A").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"

感谢其他所有人的时间/输入

导入存储为文本的日期时的日期格式错误

2 个答案: