VBA代码无响应排查：删除非月份工作表+修复日期格式

同事每日发送工作簿，每日创建对应工作表，月末生成全大写月份全名的汇总工作表。她习惯用点分隔输入日期（如01.03.2024），但这类格式无法被Excel识别，导致汇总表无法按日期范围求和。

我编写了VBA代码修复日期格式：单独运行日期转换逻辑正常，但添加遍历工作表的逻辑后，点击运行毫无反应，也无错误提示。代码逻辑为：先遍历所有工作表，删除非月份命名的工作表；再遍历剩余工作表，将A3:A50区域内的点分隔日期转换为Excel可识别格式。原代码如下：

Sub DateFix()
    Dim Months As Variant
    Dim ws As Worksheet
    Dim VC As Variant
    Dim convertedDate As Variant
    Dim SheetC As Integer
        
    SheetC = ThisWorkbook.Sheets.Count

        Months = Array("JANUARY", "FEBRUARY", "MARCH", "APRIL", "May", "June", _
        "July", "August", "September", "October", "November", "December")
    
    For i = SheetC To 1 Step -1
    Set ws = ThisWorkbook.Sheets(i)
    If IsError(Application.Match(ws.Name, Months, 0)) Then
    ws.Delete
    End If
    Next i
    
        For Each ws In ThisWorkbook.Sheets

            For Each cell In ws.Range("A3:A50")
                VC = cell.Value

                If VC <> "Saturday" And VC <> "" And VC <> "Sunday" Then
                    On Error Resume Next
                    convertedDate = DateValue(Format(Replace(VC, ".", "/"), "DD/MM/YYYY"))
                    On Error GoTo 0
                    
                    If IsDate(convertedDate) Then
                        cell.Value = convertedDate
                    Else

                    End If
                End If
            Next cell
        End If
    Next ws
End Sub

1. 月份数组大小写不匹配 #

原代码中Months数组混合了全大写（如JANUARY）和首字母大写（如May）格式，而汇总表是全大写月份名，导致Application.Match无法匹配到有效工作表，所有工作表被删除，后续日期转换逻辑无对象可处理。

2. 语法错误（多余的End If） #

第二个For Each ws循环中，没有对应的If语句却存在一个End If，这会导致代码编译失败，直接无法运行。

3. 未声明变量 #

i和cell未声明，VBA隐式声明可能引发未知问题，建议添加Option Explicit强制变量声明。

4. 日期转换逻辑优化 #

原代码的日期转换依赖系统区域设置，若系统日期格式为MM/DD/YYYY，会导致日/月颠倒。可改用Split函数拆分日期段，直接构造日期，避免区域影响。

修复后的代码 #

Option Explicit

Sub DateFix()
    Dim Months As Variant
    Dim ws As Worksheet
    Dim VC As String
    Dim convertedDate As Date
    Dim SheetC As Integer
    Dim i As Integer
    Dim cell As Range
    Dim dateParts As Variant
    
    ' 统一使用全大写月份名，匹配汇总表命名规则
    Months = Array("JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", _
                  "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER")
    
    SheetC = ThisWorkbook.Sheets.Count
    
    ' 反向遍历删除非月份命名的工作表
    For i = SheetC To 1 Step -1
        Set ws = ThisWorkbook.Sheets(i)
        ' 忽略大小写匹配（可选，增强兼容性）
        If IsError(Application.Match(UCase(ws.Name), Months, 0)) Then
            ws.Delete
        End If
    Next i
    
    ' 遍历剩余工作表转换日期
    For Each ws In ThisWorkbook.Sheets
        For Each cell In ws.Range("A3:A50")
            VC = Trim(cell.Value)
            
            If VC <> "Saturday" And VC <> "" And VC <> "Sunday" Then
                ' 用Split拆分日期，避免区域设置影响
                dateParts = Split(VC, ".")
                If UBound(dateParts) = 2 Then ' 确保是日.月.年格式的三段
                    On Error Resume Next
                    convertedDate = DateSerial(dateParts(2), dateParts(1), dateParts(0))
                    On Error GoTo 0
                    
                    If IsDate(convertedDate) Then
                        cell.Value = convertedDate
                        ' 可添加日期格式设置，让显示更直观
                        cell.NumberFormat = "DD/MM/YYYY"
                    End If
                End If
            End If
        Next cell
    Next ws
End Sub

额外说明 #

• 添加UCase(ws.Name)可兼容工作表名大小写不一致的情况；
• 用DateSerial构造日期，不受系统区域格式影响，确保DD.MM.YYYY转换为正确的日期；
• 增加Trim(cell.Value)处理单元格内的空格问题；
• 添加cell.NumberFormat强制设置日期显示格式，避免Excel自动调整。

内容的提问来源于stack exchange，提问作者user23509575