你可以给予这个。这使用RegEx （正则表达式） 来检查您的日期。
您需要设置对Microsoft VBScript正则表达式x.x的引用

Sub ChangeDates()

    Dim RegEx As New RegExp, rng As Range, i As Long, s As String
    Dim tempArr() As String, bFlag As Boolean

    With RegEx
        .Pattern = "(\d{2})/(\d{2})/(\d{4})"
        For Each rng In ActiveSheet.UsedRange
            tempArr = Split(rng.Text)
            bFlag = False
            For i = 0 To UBound(tempArr)
                If .test(tempArr(i)) Then
                    s = tempArr(i)

                    'Subtract 1 year from original date
                    s = Format(DateAdd("YYYY", -1, CDate(s)), "MM/DD/YYYY")

                    'Swap month and day field
                    tempArr(i) = Format(DateSerial(.Replace(s, "$3"), _
                            .Replace(s, "$2"), .Replace(s, "$1")), "mm/dd/yyyy")

                    'Tell VBA that the string has change and to update sheet
                    bFlag = True
                End If
            Next
            If bFlag = True Then rng.Value = Join(tempArr)
        Next rng
    End With

End Sub

RegEx模式解析：(\d{2})/(\d{2})/(\d{4})

此表达式分为三组：(\d{2})、(\d{2})、(\d{4})
组1和组2查找任意两个 （{2}） 数字 （\d），后跟正斜杠/
第3组查找正斜杠/后面的任意四个 （{4}） 数字 （\d）

• 有**FindNext**Range.FindNext Method (Excel)*
• 若要查找某个范围内的所有文本示例，您可以将**FindNext与Find配合使用，以下示例显示如何使用FindNext**。*

Option Explicit
Public Sub Example()
    Dim rng As Range
    Set rng = ThisWorkbook.Worksheets(1).UsedRange _
                          .Find("03/01/2018", LookIn:=xlValues)

    If rng Is Nothing Then
        Debug.Print "Not Found"
        Exit Sub
    End If

    Dim firstAdd As String
    firstAdd = rng.Address

    Do ' Print address
        DoEvents
        Debug.Print rng.Address
        ' Find next item
        Set rng = ThisWorkbook.Worksheets(1).UsedRange.FindNext(rng)
    Loop Until rng Is Nothing Or firstAdd = rng.Address
End Sub

• 其他信息 *
• DoEvents**对于简单的事情最有用，例如允许用户在进程启动后取消它，例如搜索文件。对于长时间运行的进程，使用Timer或将任务委托给ActiveX EXE组件可以更好地完成处理器。在后一种情况下，任务可以完全独立于您的应用程序继续执行，并且操作系统可以处理多任务和时间切片的情况。
  ***Debug.Print Immediate Window*用于调试和计算表达式、执行语句、打印变量值等。它允许您输入要在调试期间由开发语言计算或执行的表达式。若要显示“立即”窗口，请打开一个项目进行编辑，然后从“调试”菜单中选择“窗口”，然后选择“立即”，或按CTRL+ALT+I。

Excel中字符串的多次研究和替换

这是一个VBA代码，用于Excel选定工作表单元格中字符串的多次研究和替换
我的目标是找到并替换活动工作表中的错误字符编码：

• é->（replaced by）é

• • è

• 联系我们

• • î

• ª-> ê
• à-> à

在https://www.rondebruin.nl/win/s3/win002.htm中找到所需的通用功能
Sub Multi_FindReplace（）改编自https://www.mrexcel.com/board/threads/find-and-replace-multiple-values.1230258/

' Common Functions required for all routines

' Find the last row with data in sheet
Function LastRow(Sh As Worksheet)
    On Error Resume Next
    LastRow = Sh.Cells.Find(What:="*", _
                            After:=Sh.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

' Find the last col with data in sheet
Function LastCol(Sh As Worksheet)
    On Error Resume Next
    LastCol = Sh.Cells.Find(What:="*", _
                            After:=Sh.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

' Find and replace for bad character encoding in active sheet
' é  -> é
' è -> è
' ’ -> '
' î -> î
' ê -> ê
' Ã -> à

Sub Multi_FindReplace()

    Dim Sh As Worksheet
    Dim LastR, LastC As Long
    Dim Range As Range
    Dim FindTips As Variant
    Dim RplcTips As Variant
    Dim y As Long
    
    ' Search
    FindTips = Array("é", "è", "’", "î", "ê", "Ã")
    ' Replacement
    RplcTips = Array("é", "è", "'", "î", "ê", "à")
    
    ' Select active sheet
    ActiveSheet.Select
    Set Sh = ActiveSheet
    
    ' Find the last row with data
    LastR = LastRow(Sh)
    ' MsgBox LastR
    
    ' Find the last col with data
    LastC = LastCol(Sh)
    ' MsgBox LastC
    
    ' Select Cells Range
    Set Range = ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(LastR, LastC))
    
    With Range
        For y = LBound(FindTips) To UBound(FindTips)
            Range.Replace What:=FindTips(y), Replacement:=RplcTips(y), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        Next y
    End With
    

End Sub