-1
我有一個代碼，它可以排序並創建不同的範圍值組。我有一個每小時度量標準的列，我將它排序，並將6-8中的任何值組合在一起，並創建一個命名該組6-8 MTPH的新列。我以6-8,10-15,16-21,24-28和40-48的方式做到這一點。問題是它爲每行都設置了這個標題，因此對於16-21組中包含的每一行都有一個16-21 MTPH標籤。我希望我的代碼能夠合併並居中所有這些單元格，以便每個組只有一個標籤。代碼中有一個合併函數，有人幫我，但它調試.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