Question

此代码的目的是格式化3个不同MS Excel文件的日期。每个文件都以不同的名称开头。一个是AT，另一个是PT，最后一个是MX。根据文件名中的前两个字符，日期的格式将不同。

例如：

当PT和AT的日期是这样时：20100710

我们使用这个公式：

=RIGHT(B38;2)&"."&MID(B38;5;2)&"."&LEFT(B38;4)

结果是：10.07.2010

MX的日期如下：1/1/2010

我们使用这个公式：

="0"&LEFT(B39;1)&"."&"0"&MID(B39;3;1)&"."&RIGHT(B39;4)

结果是：01.01.2010

然后我们使用Excel中的格式将其更改为：dd.mm.year

该工作表称为“数据”，它是Excel文件中唯一的活动工作表。

代码当前没有任何操作，没有错误等。它循环浏览文件夹中的工作表并保存它们。它没有改变“AT”或“PT”的日期。

Option Explicit

Public Sub FormatDates()
Dim wbOpen As Workbook
Dim strExtension As String

Const strPath As String = "H:\"    'Change Path to the folder you have your files in

    'Comment out the 3 lines below to debug
'    Application.ScreenUpdating = False
'    Application.Calculation = xlCalculationManual
'    On Error Resume Next

    ChDir strPath
    strExtension = Dir(strPath & "*.xls")      'change to xls if using pre 2007 excel

        Do While strExtension <> ""
            Set wbOpen = Workbooks.Open(strPath & strExtension)

            With wbOpen
               If Left(LCase(.Name), 2) = "pt" Or Left(LCase(.Name), 2) = "at" Then     'change to lower case and check start of name
                    ChangeAllDates ("NOT MX")
                    .Close SaveChanges:=True
               ElseIf Left(LCase(.Name), 2) = "mx" Then
                    ChangeAllDates ("MX")
                    .Close SaveChanges:=True
               Else
                   .Close SaveChanges:=False
               End If
            End With

            strExtension = Dir
        Loop

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0

End Sub

Private Function ChangeAllDates(strType As String)
Dim strTemp As String
Dim strCellValue As String
Dim rng As Range
Dim cell As Range
Dim sht As Worksheet

    Set sht = ActiveSheet

    Sheets("data").Activate     'selects sheet named data

    Set rng = Range("C2:C" & GetLastPopulatedCell(2, 2, sht)) 'finds last populated cell

    On Error GoTo err_check

    For Each cell In rng

        strCellValue = CStr(cell.Value)

        If Len(strCellValue) > 2 Then   'only check cells that have more than 2 charactors in them

            If InStr(1, strCellValue, ".", vbTextCompare) = 0 Then
                If strType = "MX" Then
                    strTemp = Left(strCellValue, 4) & "." & Mid(strCellValue, 5, 2) & "." & Right(strCellValue, 2)
                Else
                    strTemp = Right(strCellValue, 2) & "." & Mid(strCellValue, 5, 2) & "." & Left(strCellValue, 2)
                End If

                If InStr(1, strCellValue, "/", vbTextCompare) > 0 Then      'change data / to .
                    strTemp = Replace(strCellValue, "/", ".", 1, , vbTextCompare)

                    'now check to make sure that it reads yyyy.mm.dd if not then we need to reverse it and check
                    'it has 2 numbers for month and year

                    strTemp = CheckDataFormat(strTemp)


                End If
            Else
                strTemp = strCellValue
            End If

            cell.Value = strTemp        'replace the cell value with the formatted value

            strCellValue = ""
            strTemp = ""

            End If

    Next cell

    On Error GoTo 0

    Exit Function

err_check:

    MsgBox Error.Name & vbCrLf & "Error happend on cell " & cell.Address

End Function

Private Function GetLastPopulatedCell(lgRow As Long, lgCol As Long, sht As Worksheet) As Long
Dim i As Integer
Dim s As String

    For i = 0 To 10000        'set a default number of cells to check in this case I have set it to 10,000
        If sht.Cells(lgRow, lgCol).Value <> "" Then
            lgRow = lgRow + 1
        Else
            GetLastPopulatedCell = lgRow - 1
            Exit For
        End If
    Next i

End Function

Private Function CheckDataFormat(str As String) As String

Dim strR As String
Dim i As Integer
Dim vArray As Variant

'str = "06.01.2011"

    'have to check if date is in d.m.yyyy format if so we need to change it to dd.mm.yyyy

    If Len(str) < 10 Then           'only care if less than 10 charators

        vArray = Split(str, ".")    'split into array on points
        str = ""

        For i = 0 To UBound(vArray)

            If Len(vArray(i)) = 1 Then                  'if only 1 charactor long we know we are missing 0
                str = str & "0" & vArray(i) & "."       'check if 0 exists before number if not add it
            Else
                str = str & vArray(i) & "."
            End If
        Next i

        'remove last dot on the end
        If Right(str, 1) = "." Then str = Left(str, Len(str) - 1)
    End If

    Debug.Print str

    'strR = Right(str, 5)

    'If Left(strR, 1) = "." Then
     '   str = Right(str, 4) & "." & Left(str, (Len(str) - 5))       'move the year to the front
      '  str = Left(str, 5) & Right(str, 2) & Mid(str, 5, 3)         'switch round month and day
     '   Debug.Print str
    'End If

    CheckDataFormat = str

End Function

Answer 1

我认为AT，PT和MX代表奥地利，葡萄牙和墨西哥的国家代码......

一般来说，我对国际Excel应用程序的体验是：不要在Excel中格式化日期！这就是我的工作：

确保包含日期的单元格中的条目确实已完成/识别为日期格式（vartype(cell) = vbDate） - 您可以通过Sub ...Change()触发器检查/捕获此内容
以系统的短格式或长格式格式化/显示日期格式（根据需要/品味）

它应该并且应该保持以用户的力量来选择应用程序应该尊重的他/她最喜欢的（系统）日期格式。这样你就可以解决游牧用户日益增长的问题（例如英国人在法国工作，法国人到美国旅游等）。

其他任何事情都会增加麻烦 - 比如你的例子中你正在转换为字符串......
所以你可以忘记日期算术，除非你转换回来...另一个需要识别国家特定细节的功能
明天你的公司去法国，巴西和南非......再次遇到麻烦

希望这有帮助

祝你好运 - MikeD

将不同的日期格式格式化为标准格式

1 个答案: