-1

我有一个代码可以对不同范围的值进行排序和创建。我有一个列，其中包含 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
4

2 回答 2

0

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

With Activesheet.Range(strRangeToMerge)
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With
于 2013-05-16T22:21:57.363 回答
0

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

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

您可以关闭自动筛选，并且可以Unlist将ListObject. 我已经在这里提供了解决方案。

代码替换表头并且不会合并行

请避免以后出现重复的问题。

于 2013-05-17T03:35:08.170 回答