Как исправить макрос слияния в моем коде?

Question

У меня есть код, который сортирует и создает разные группы значений. У меня есть столбец с метрическими тонами в час в нем, который я сортирую, и он группирует любые значения из 6-8 вместе и создает новый столбец, называя эту группу 6-8 MTPH. Я делаю это с 6-8, 10-15, 16-21, 24-28 и 40-48. Проблема в том, что он делает этот заголовок для каждой строки, поэтому для каждой строки, включенной в группу 16-21, есть метка RIM 16-21. Я хочу, чтобы мой код объединялся и центрировал все эти ячейки, поэтому для каждой группы есть только один ярлык. В коде есть функция 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 есть проблемы с диапазонами, если они не относятся к определенному листу. Это странная ошибка, и на ней нет никакой реальной документации, но раньше у меня была такая же проблема. Ошибка возникает из-за того, что она вызывает диапазон, и она не знает, где она ссылается, поскольку она не имеет значения по умолчанию для активного листа. Попробуйте:

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

Answer 2

Если вы внимательно посмотрите на файл - при условии, что это тот же самый файл, который Harris Элдридж по электронной почте мне ранее сегодня - вы увидите, что вы не можете даже объединить ячейки с помощью опции ленты ,

Это потому, что ваш файл содержит таблицу ListObject, которая не может быть объединена. Кроме того, вы, вероятно, не отключили автофильтр, который снова не может быть объединен.

Вы можете отключить автофильтр, и вы можете Unlist a ListObject. Я уже здесь предложил решение.

Code replaces table headers and will not merge rows

Пожалуйста, во избежание дублирования вопросов в будущем.