Question

我有数据库中的这个日期，我想在VBA excel中修复该日期，因为excel在过滤列时会用月份切换日期

27/08/2018
31/08/2018
12/9/2018
2/8/2018    wrong date reported at filter in excel need 02/08/2018
6/8/2018    wrong date reported at filter in excel need 06/08/2018
13/08/2018
17/08/2018
20/08/2018
20/08/2018

我已经尝试过

For i = 2 To lastRow
    Dim fDate As Date
    Dim dayF As String
    Dim monthF As String
    Dim yearF As String


    Set r = Cells(i, Column_DateStamp)
    strDate = Split(r.Text, "/")

    dayF = CStr(Format(strDate(0), "00"))
    monthF = CStr(Format(strDate(1), "00"))
    yearF = CStr(Format(strDate(2), "0000"))
    fDate = Format(DateSerial(strDate(2), CStr(Format(strDate(1), "00")), CStr(Format(strDate(0), "00"))), "dd/mm/yyyy")
    r.Clear
    r.Value = fDate
Next i

Answer 1

日期格式与您的本地日期格式不匹配，因此Excel正在尝试进行转换。

您需要输入日期并适当地设置其格式，或者制作单元格文本，以便excel不会尝试转换。

Dim i As Long
For i = 2 To lastRow
    Dim fDate As Date

    Dim r As Range

    Set r = Cells(i, Column_DateStamp)
    strDate = Split(r.Text, "/")

    fDate = DateSerial(strDate(2), strDate(1), strDate(0))

    r.Clear
    'True date - comment out if you want string
    r.NumberFormat = "dd/mm/yyyy"
    r.Value2 = fDate
    'String - Uncomment if you want string
'    r.NumberFormat = "@"
'    r.Value2 = Format(fDate, "dd/mm/yyyy")

Next i

Answer 2

检查屏幕快照，该问题与您的Windows区域设置为MDY和数据库设置为DMY一致。这将始终导致Excel的错误操作。

无论是谁编写的ERP应用程序，都应该能够进行更改，以将明确的日期格式输入到Excel；或在导入时触发excel文本导入向导。

您可以同时尝试此宏。应该可以，但是请仔细阅读说明以防可能的陷阱：

Option Explicit
Sub ConvertDates()
    'converts dates that have been mismatched MDY / DMY
    'Assumes dates are all in selected column
    '   Only need to select a single cell in the column
    '   will place results in a column next to original data
    ' If adjacent column is not blank, a column will be inserted
    'Figures out the original format by analyzing a "text" date
    'Time components are converted directly.  This might be OK unless
    ' in a non standard format such as 1400Z

Dim R As Range, C As Range
Dim sDelim As String
Dim FileDateFormat As String * 3
Dim i As Long, j As Long, V As Variant
Dim vDateParts As Variant
Dim YR As Long, MN As Long, DY As Long
Dim TM As Double
Dim vRes As Variant 'to hold the results of conversion

Set R = Selection

'Test that selected cell contains a date
If Not IsDate(R(1)) Then
    MsgBox "Select a cell containing a date"
    Exit Sub
End If

Set R = Intersect(R.EntireColumn, ActiveSheet.UsedRange)
ReDim vRes(1 To R.Rows.Count, 1 To 1)

'Find a "text date" cell to analyze
For Each C In R
    With C
    If IsDate(.Value) And Not IsNumeric(.Value2) Then
        'find delimiter
        For i = 1 To Len(.Text)
            If Not Mid(.Text, i, 1) Like "#" Then
                sDelim = Mid(.Text, i, 1)
                Exit For
            End If
        Next i

        'split off any times
        V = Split(.Text & " 00:00")
        vDateParts = Split(V(0), sDelim)

        If vDateParts(0) > 12 Then
            FileDateFormat = "DMY"
            Exit For
        ElseIf vDateParts(1) > 12 Then
            FileDateFormat = "MDY"
            Exit For
        Else
            MsgBox "cannot analyze data"
            Exit Sub
        End If
    End If
    End With
Next C

If sDelim = "" Then
   MsgBox "cannot find problem"
   Exit Sub
End If

'Check that analyzed date format different from Windows Regional Settings
Select Case Application.International(xlDateOrder)
    Case 0 'MDY
        If FileDateFormat = "MDY" Then
            MsgBox "File Date Format and Windows Regional Settings match" & vbLf _
                & "Look for problem elsewhere"
            Exit Sub
        End If
    Case 1 'DMY
        If FileDateFormat = "DMY" Then
            MsgBox "File Date Format and Windows Regional Settings match" & vbLf _
                & "Look for problem elsewhere"
            Exit Sub
        End If
End Select

'Process dates
'Could shorten this segment but probably more understandable this way
j = 0
Select Case FileDateFormat
    Case "DMY"
        For Each C In R
        With C
            If IsDate(.Value) And IsNumeric(.Value2) Then
            'Reverse the day and the month
                YR = Year(.Value2)
                MN = Day(.Value2)
                DY = Month(.Value2)
                TM = .Value2 - Int(.Value2)
            ElseIf IsDate(.Value) And Not IsNumeric(.Value2) Then
                V = Split(.Text & " 00:00") 'remove the time
                vDateParts = Split(V(0), sDelim)
                YR = vDateParts(2)
                MN = vDateParts(1)
                DY = vDateParts(0)
                TM = TimeValue(V(1))
            Else
                YR = 0
            End If

            j = j + 1
            If YR = 0 Then
                vRes(j, 1) = C.Value
            Else
                vRes(j, 1) = DateSerial(YR, MN, DY) + TM
            End If
        End With
        Next C
    Case "MDY"
        For Each C In R
        With C
            If IsDate(.Value) And IsNumeric(.Value2) Then
            'Reverse the day and the month
                YR = Year(.Value2)
                MN = Day(.Value2)
                DY = Month(.Value2)
                TM = .Value2 - Int(.Value2)
            ElseIf IsDate(.Value) And Not IsNumeric(.Value2) Then
                V = Split(.Text & " 00:00") 'remove the time
                vDateParts = Split(V(0), sDelim)
                YR = vDateParts(2)
                MN = vDateParts(0)
                DY = vDateParts(1)
                TM = TimeValue(V(1))
            Else
                YR = 0
            End If

            j = j + 1
            If YR = 0 Then
                vRes(j, 1) = C.Value
            Else
                vRes(j, 1) = DateSerial(YR, MN, DY) + TM
            End If
        End With
        Next C
End Select

With R.Offset(0, 1).EntireColumn
    Set C = .Find(what:="*", LookIn:=xlFormulas)
    If Not C Is Nothing Then .EntireColumn.Insert
End With

R.Offset(0, 1).Value = vRes

End Sub

领先的零VBA Excel错误的日期

2 个答案: