알파벳순 및 셀순으로 정렬

Question

여러 목록을 알파벳순으로 정렬하고 셀 색순으로 정렬하려고하지만 특정 범위 내에서 정렬하려고합니다. 너무 길지 않습니다. 기본적으로 VBA는 예를 들어 B 열 3-88 행을 선택하고 알파벳순으로 정렬 한 다음 색상별로 정렬한다고 가정합니다. 그런 다음 컬럼 C3 : C88 등 다음 컬럼으로 이동하여 NY 컬럼까지 이동하십시오.

시도 할 때 런타임 오류 1004가 발생합니다. 개체 '_Global'의 Mathod "Range"가 실패했습니다. 이것은 나를 위해 일한

Sub SortAlphaColor() 
' Sorts rows within a list from A-Z 
' Run Clean all first to avoid sorting blanks 
' Set maximum range to avoid sorting too many rows 

    Dim rngFirstRow As Range 
    Dim rng As Range 
    Dim ws As Worksheet 

    Application.ScreenUpdating = False 
    Set ws = ActiveSheet 
    Set rngFirstRow = ws.Range("B3:NY3") 
    For Each rng In rngFirstRow 
     With ws.Sort 
      .SortFields.Clear 
      .SortFields.Add Key:=rng, Order:=xlAscending 
      'assuming there are no blank cells.. 
      .SetRange ws.Range(rng, rng.Range("B88").End(xlUp)) 
       'VBA from second module 
       .SortFields.Add(Range(rng), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, 239, 206) <- this line is highlighted in debug 
       .Orientation = xlTopToBottom 
       .SortMethod = xlPinYin 
      .Header = xlYes 
      .MatchCase = False 
      .Apply 
     End With 
    Next rng 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

:

이

Sub SortAlphaColor() 

    Dim rngFirstRow As Range 
    Dim rng As Range, rngSort As Range 
    Dim ws As Worksheet 

    Application.ScreenUpdating = False 
    Set ws = ActiveSheet 
    Set rngFirstRow = ws.Range("B3:NY3") 
    For Each rng In rngFirstRow.Cells 
     With ws.Sort 

      Set rngSort = rng.Resize(86, 1) 'to row 88 

      .SortFields.Clear 
      .SortFields.Add Key:=rng, SortOn:=xlSortOnValues, _ 
          Order:=xlAscending, DataOption:=xlSortNormal 
      .SortFields.Add(rng, xlSortOnCellColor, xlAscending, , xlSortNormal). _ 
          SortOnValue.Color = RGB(198, 239, 206) 
      .SetRange rngSort 
      .Header = xlNo 
      .MatchCase = False 
      .Orientation = xlTopToBottom 
      .SortMethod = xlPinYin 
      .Apply 

     End With 
    Next rng 
    Application.ScreenUpdating = True 
End Sub