在代号和名称不变的情况下使规格从小到大排序，见下图

问路1

原来高手帮写的，现在能不能在上面改一下，如果高手看到了，敬请帮忙。谢谢。
Sub yy() 'hlly888
Range("a2:i65536").ClearContents
Application.ScreenUpdating = False
Dim dc(1 To 2), arr, brr(), cr, i&, w, s&, j%, h, g, x&
For i = 1 To 2
Set dc(i) = CreateObject("Scripting.Dictionary")
Next
arr = Sheets("数据").Range("a1").CurrentRegion
cr = Array(" ", "G", "P", "D", "E", "T", "R", "H", "M", "Z", "J", "F")
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))

    For j = 1 To 11
        dc(1)(cr(j)) = j
    Next
    For i = 2 To UBound(arr)
        w = dc(2)(arr(i, 3) & arr(i, 4))
        If w = "" Then
           a = Left(arr(i, 2), 1)
           s = s + 1: brr(s, 1) = dc(1)(a)
           dc(2)(arr(i, 3) & arr(i, 4)) = s
           For j = 2 To UBound(arr, 2)
               brr(s, j) = arr(i, j)
           Next
           h = h + arr(i, 6): g = g + arr(i, 9)
        Else
           brr(w, 6) = brr(w, 6) + arr(i, 6)
           brr(w, 9) = brr(w, 9) + arr(i, 9)
           h = h + arr(i, 6): g = g + arr(i, 9)
        End If
    Next
    brr(s + 1, 2) = "合计": brr(s + 1, 6) = h: brr(s + 1, 9) = g

x = Cells(Rows.Count, 1).End(xlUp).Row
[a2].Resize(x + 10, UBound(arr, 2)).ClearFormats
[a2].Resize(s + 1, UBound(arr, 2)) = brr
[a2].Resize(s + 1, UBound(arr, 2)).Sort Range("c2")
[a2].Resize(s + 1, UBound(arr, 2)).Sort Range("a2")
[a1].Resize(s + 2, UBound(arr, 2)).Borders.LineStyle = xlContinuous
Columns("a:i").HorizontalAlignment = xlCenter
Application.ScreenUpdating = True
End Sub