Excel 如何修复代码中的合并宏？

我有一个代码，可以排序并创建不同范围的值组。我有一个每小时公吨的列，我对它进行排序，它将6-8之间的任何值分组在一起，并创建一个新列，命名为6-8 MTPH组。我用6-8，10-15，16-21，24-28和40-48来做这个。问题是它对每一行都执行此标题，因此16-21组中包含的每一行都有一个16-21 MTPH标签。我希望我的代码合并并居中所有这些单元格，以便每个组只有一个标签。代码中有一个Merge函数，有人帮过我，但它在上面调试。Merge带有运行时错误“1004”：应用程序定义的错误或对象定义的错误。下面是我正在使用的代码，如果您能帮我解决这个问题，我将不胜感激

Sub SystemSize()

Dim lastRow As Long
Dim i As Long, groups As Long
Dim intStart As Integer
Dim intFinish As Integer

lastRow = Range("I" & Rows.Count).End(xlUp).Row
Range("A2:I" & lastRow).Sort key1:=Range("I2"), order1:=xlAscending, Header:=xlYes

groups = 1


Do While groups < 8
 i = 2
    Select Case groups
      Case 1


    For j = 2 To lastRow

        If Cells(j, 9) >= 6 And Cells(j, 9) <= 7 Then

            If intStart > 0 Then
                intStart = intStart
                    Else
                    intStart = j
            End If

            intEnd = j

            Cells(j, 1) = "6-7 MTPH" 'Cells(j, 1)
             i = i + 1
        End If
    Next

    strRangeToMerge = "A" & intStart & ":A" & intEnd

    Application.DisplayAlerts = False

    With Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Application.DisplayAlerts = True

    intStart = 0

Case 2


    For j = 2 To lastRow
        If Cells(j, 9) >= 10 And Cells(j, 9) <= 15 Then

            If intStart > 0 Then
                intStart = intStart
                    Else
                    intStart = j
            End If

            intEnd = j

            Cells(j, 1) = "10-15 MTPH"
             i = i + 1
        End If
    Next

    strRangeToMerge = "A" & intStart & ":A" & intEnd

    Application.DisplayAlerts = False

    With Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Application.DisplayAlerts = True

    intStart = 0


Case 3

    'Cells(1, 4) = "'16-21"
    For j = 2 To lastRow
        If Cells(j, 9) >= 16 And Cells(j, 9) <= 21 Then

         If intStart > 0 Then
                intStart = intStart
                    Else
                    intStart = j
            End If

        intEnd = j

            Cells(j, 1) = "16-21 MTPH"
             i = i + 1
        End If
    Next

    strRangeToMerge = "A" & intStart & ":A" & intEnd

    Application.DisplayAlerts = False

    With Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Application.DisplayAlerts = True

    intStart = 0


Case 4
    'Cells(1, 5) = "'24-28"
    For j = 2 To lastRow
        If Cells(j, 9) >= 24 And Cells(j, 9) <= 28 Then

         If intStart > 0 Then
                intStart = intStart
                    Else
                    intStart = j
            End If

        intEnd = j

            Cells(j, 1) = "24-28 MTPH"
             i = i + 1
        End If
    Next


      strRangeToMerge = "A" & intStart & ":A" & intEnd

    Application.DisplayAlerts = False

    With Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Application.DisplayAlerts = True

    intStart = 0

Case 5
    'Cells(1, 6) = "'30-38"
    For j = 2 To lastRow
        If Cells(j, 9) >= 30 And Cells(j, 9) <= 38 Then

         If intStart > 0 Then
                intStart = intStart
                    Else
                    intStart = j
            End If

        intEnd = j

            Cells(j, 1) = "30-38 MTPH"
        End If
    Next


      strRangeToMerge = "A" & intStart & ":A" & intEnd

    Application.DisplayAlerts = False

    With Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Application.DisplayAlerts = True

    intStart = 0

Case 6
    'Cells(1, 7) = "'40-48"
    For j = 2 To lastRow
        If Cells(j, 9) >= 40 And Cells(j, 9) <= 48 Then

         If intStart > 0 Then
                intStart = intStart
                    Else
                    intStart = j
            End If

        intEnd = j

            Cells(j, 1) = "40-48 MTPH"
             i = i + 1
        End If
    Next

      strRangeToMerge = "A" & intStart & ":A" & intEnd

    Application.DisplayAlerts = False

    With Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    Application.DisplayAlerts = True

    intStart = 0

Case 7
   For j = 2 To lastRow
        If Cells(j, 9) > 0 And Cells(j, 9) < 6 Or Cells(j, 9) > 48 Then
            Cells(j, 1) = "No Group"
             i = i + 1
        End If
    Next

End Select

groups = groups + 1
Loop

End Sub

子系统大小（）
最后一排一样长
我一样长，团体一样长
Dim intStart为整数
Dim intFinish作为整数
lastRow=范围（“I”和Rows.Count）.End（xlUp）.Row
范围（“A2:I”和lastRow）。排序键1:=范围（“I2”），顺序1:=xl升序，标题：=xlYes
组=1
当组<8时，进行测试
i=2
选择案例组
案例1
对于j=2到最后一行
如果单元格（j，9）>=6且单元格（j，9）为0，则
intStart=intStart
其他的
intStart=j
如果结束
意愿=j
细胞（j，1）=“6-7 MTPH”细胞（j，1）
i=i+1
如果结束
下一个
strRangeToMerge=“A”&intStart&“：A”&intent
Application.DisplayAlerts=False
带射程（strRangeToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
Application.DisplayAlerts=True
intStart=0
案例2
对于j=2到最后一行
如果单元格（j，9）>=10且单元格（j，9）为0，则
intStart=intStart
其他的
intStart=j
如果结束
意愿=j
细胞（j，1）=“10-15 MTPH”
i=i+1
如果结束
下一个
strRangeToMerge=“A”&intStart&“：A”&intent
Application.DisplayAlerts=False
带射程（strRangeToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
Application.DisplayAlerts=True
intStart=0
案例3
'单元格（1,4）=''16-21'
对于j=2到最后一行
如果单元格（j，9）>=16且单元格（j，9）为0，则
intStart=intStart
其他的
intStart=j
如果结束
意愿=j
细胞（j，1）=“16-21 MTPH”
i=i+1
如果结束
下一个
strRangeToMerge=“A”&intStart&“：A”&intent
Application.DisplayAlerts=False
带射程（strRangeToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
Application.DisplayAlerts=True
intStart=0
案例4
'单元格（1,5）=''24-28'
对于j=2到最后一行
如果单元格（j，9）>=24且单元格（j，9）为0，则
intStart=intStart
其他的
intStart=j
如果结束
意愿=j
细胞（j，1）=“24-28 MTPH”
i=i+1
如果结束
下一个
strRangeToMerge=“A”&intStart&“：A”&intent
Application.DisplayAlerts=False
带射程（strRangeToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
Application.DisplayAlerts=True
intStart=0
案例5
'单元格（1,6）=''30-38'
对于j=2到最后一行
如果单元格（j，9）>=30且单元格（j，9）为0，则
intStart=intStart
其他的
intStart=j
如果结束
意愿=j
细胞（j，1）=“30-38 MTPH”
如果结束
下一个
strRangeToMerge=“A”&intStart&“：A”&intent
Application.DisplayAlerts=False
带射程（strRangeToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
Application.DisplayAlerts=True
intStart=0
案例6
'单元格（1,7）=''40-48'
对于j=2到最后一行
如果单元格（j，9）>=40且单元格（j，9）为0，则
intStart=intStart
其他的
intStart=j
如果结束
意愿=j
细胞（j，1）=“40-48 MTPH”
i=i+1
如果结束
下一个
strRangeToMerge=“A”&intStart&“：A”&intent
Application.DisplayAlerts=False
带射程（strRangeToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
Application.DisplayAlerts=True
intStart=0
案例7
对于j=2到最后一行
如果单元格（j，9）>0且单元格（j，9）<6或单元格（j，9）>48，则
单元（j，1）=“无组”
i=i+1
如果结束
下一个
结束选择
组=组+1
环
端接头

有时，如果excel没有引用特定的工作表，则其范围会出现问题。这是一个奇怪的错误，没有任何真正的文档，但我以前也遇到过同样的问题。出现此错误是因为它正在调用一个范围，并且不知道引用的位置，因为它不默认为活动工作表。尝试：

With Activesheet.Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With

---

如果仔细查看您的文件——假设它与Harris Eldridge今天早些时候给我发电子邮件的文件完全相同——您会发现，您甚至无法使用ribbon选项合并单元格

这是因为您的文件包含无法合并的表ListObject。另外，您可能没有关闭自动过滤器，因为它同样无法合并

您可以关闭自动筛选功能，也可以

取消列出
ListObject
。我已经在这里提供了解决方案


今后请避免重复提问。