嘿，作为VBA新手面对上千条记录+百种时段变体，确实不用写100多条If判断！咱们可以用分组合并+字典统计的思路来搞定，既高效又灵活，下面给你具体的实现步骤和代码：

核心思路 #

1. 把原时段字符串拆成「星期缩写+时段」的小单元
2. 用字典把相同时段对应的所有星期归类到一起
3. 把每组的星期缩写合并成连续范围（比如M/T/W/R/F → M-F）
4. 最后把每组的「星期范围+时段」用分号拼接成最终格式

可直接用的VBA自定义函数 #

打开Excel的VBA编辑器（按Alt+F11），插入一个新模块，粘贴下面的代码：

Function MergeSchedule(rawText As String) As String
    Dim dict As Object
    Dim parts() As String, part As Variant
    Dim dayAbbr As String, timeSlot As String
    Dim dayOrder As Variant, dayMap As Object
    Dim key As Variant, daysCollection As Collection
    Dim i As Integer, startIdx As Integer, endIdx As Integer
    Dim resultParts As Collection
    
    ' 初始化工具对象
    Set dict = CreateObject("Scripting.Dictionary")
    Set dayMap = CreateObject("Scripting.Dictionary")
    Set resultParts = New Collection
    
    ' 定义星期顺序和缩写映射（匹配你的需求，比如S转SA）
    dayOrder = Array("M", "T", "W", "R", "F", "S", "SU")
    dayMap("M") = "M"
    dayMap("T") = "T"
    dayMap("W") = "W"
    dayMap("R") = "R"
    dayMap("F") = "F"
    dayMap("S") = "SA"
    dayMap("SU") = "SU"
    
    ' 拆分原字符串成单个「星期+时段」单元
    parts = Split(rawText, " ")
    For i = LBound(parts) To UBound(parts) Step 2
        If i + 1 <= UBound(parts) Then
            dayAbbr = parts(i)
            timeSlot = parts(i + 1)
            
            ' 把相同时段的星期归类到字典
            If Not dict.Exists(timeSlot) Then
                Set dict(timeSlot) = New Collection
            End If
            dict(timeSlot).Add dayAbbr
        End If
    Next i
    
    ' 处理每个时段对应的星期，合并成范围
    For Each key In dict.Keys
        Set daysCollection = dict(key)
        Dim sortedDays As Collection
        Set sortedDays = New Collection
        
        ' 按星期顺序排序
        For Each day In dayOrder
            For Each d In daysCollection
                If d = day Then
                    sortedDays.Add d
                    Exit For
                End If
            Next d
        Next day
        
        ' 合并连续的星期
        Dim mergedDays As String
        mergedDays = ""
        startIdx = 1
        For i = 2 To sortedDays.Count
            ' 检查当前星期和前一个是否连续
            If GetDayIndex(sortedDays(i), dayOrder) <> GetDayIndex(sortedDays(i - 1), dayOrder) + 1 Then
                ' 不连续，处理前面的范围
                If startIdx = i - 1 Then
                    mergedDays = mergedDays & dayMap(sortedDays(startIdx)) & ", "
                Else
                    mergedDays = mergedDays & dayMap(sortedDays(startIdx)) & "-" & dayMap(sortedDays(i - 1)) & ", "
                End If
                startIdx = i
            End If
        Next i
        
        ' 处理最后一组
        If startIdx = sortedDays.Count Then
            mergedDays = mergedDays & dayMap(sortedDays(startIdx))
        Else
            mergedDays = mergedDays & dayMap(sortedDays(startIdx)) & "-" & dayMap(sortedDays(sortedDays.Count))
        End If
        
        ' 添加到结果集合
        resultParts.Add mergedDays & " " & key
    Next key
    
    ' 拼接最终结果
    Dim finalResult As String
    finalResult = ""
    For Each part In resultParts
        finalResult = finalResult & part & "; "
    Next part
    ' 去掉末尾多余的分号和空格
    MergeSchedule = Left(finalResult, Len(finalResult) - 2)
End Function

' 辅助函数：获取星期在顺序数组中的索引
Function GetDayIndex(dayAbbr As String, dayOrder As Variant) As Integer
    For i = LBound(dayOrder) To UBound(dayOrder)
        If dayOrder(i) = dayAbbr Then
            GetDayIndex = i
            Exit Function
        End If
    Next i
    GetDayIndex = -1
End Function

怎么用这个函数？ #

1. 回到Excel，在你想要生成转换结果的新列（比如B列），第一个单元格输入=MergeSchedule(A1)（A1是原时段所在的单元格）
2. 下拉填充公式，就能批量转换所有9000+条记录
3. 如果想用按钮批量处理：
   • 开发工具选项卡 → 插入按钮（表单控件）
   • 绑定一个宏，宏里写循环遍历所有行调用这个函数就行，比如：

     Sub BatchConvert()
         Dim lastRow As Long
         lastRow = Cells(Rows.Count, "A").End(xlUp).Row
         For i = 1 To lastRow
             Cells(i, "B").Value = MergeSchedule(Cells(i, "A").Value)
         Next i
     End Sub
     

测试你的示例 #

• 输入：M 8:30 AM-5:30 PM T 8:30 AM-5:30 PM W 8:30 AM-5:30 PM R 8:30 AM-5:30 PM F 8:30 AM-5:30 PM
  输出：M-F 8:30 AM-5:30 PM
• 输入：M 7:30 AM-11:00 PM T 7:30 AM-11:00 PM W 7:30 AM-11:00 PM R 7:30 AM-11:00 PM F 7:30 AM-11:00 PM S 8:00 AM-9:00 PM
  输出：M-F 7:30 AM-11:00 PM; SA 8:00 AM-9:00 PM

注意事项 #

• 如果你的星期缩写有其他变体（比如SU代表周日），直接修改dayOrder和dayMap即可，不用改核心逻辑
• 要是时段里有空格（比如8:30 AM - 11:00 PM），可以在代码开头加rawText = Replace(rawText, " - ", "-")统一格式

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