Question

我有一个代码可以对各种范围的值组进行排序和创建。我有一个Metric Tons Per Hour的列，我对它进行排序，它将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

Answer 1

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

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

Answer 2

如果你仔细查看你的文件 - 假设它与Harris Eldridge今天早些时候通过电子邮件发送的完全相同的文件 - 你会看到你甚至无法使用功能区选项合并单元格。

这是因为您的文件包含一个无法合并的表ListObject。此外，您可能没有关闭AutoFilter，再次无法合并。

您可以关闭自动过滤功能，您可以Unlist ListObject。我已经在这里提供了解决方案。

Code replaces table headers and will not merge rows

以后请避免重复提问。

如何在我的代码中修复Merge宏？

2 个答案: