結合兩個VBA任務

Question

我試圖結合兩個函數。我有一個VBA腳本，它通過一個設定範圍，並按字母順序排列所有文本。

Sub SortIndividualRows() 
' 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("A1:NS1") 
    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("A87").End(xlUp)) 
      .Header = xlYes 
      .MatchCase = False 
      .Apply 
     End With 
    Next rng 
    Application.ScreenUpdating = True 
End Sub 

我想結合這個腳本，然後按顏色對每列進行排序。當我手動排序並查看記錄生成的代碼時，我記錄了一個宏。我想弄清楚如何將生成的代碼與上面的函數結合起來。

Sub sortColor() 
' 
' sortColor Macro 
' Goes through a range of selected cells and sorts by color, setting green cells (matches) above those with no match (red text) 
' 

' 
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("F4:F88"), _ 
     xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, _ 
     239, 206) 
    With ActiveWorkbook.Worksheets("Sheet1").Sort 
     .SetRange Range("F3:F88") 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
End Sub 

Answer 1

只是爲了澄清一下，你想運行一個模塊，然後另一個模塊事後？或者你希望第二個模塊的動作在每次for循環完成時運行？

要運行一前一後直接：

子SortIndividualRows（） 「排序從AZ 列表內的行」潤潔所有的第一，以避免排序空白 「設置最大範圍，以避免排序太多的行

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

Application.ScreenUpdating = False 
Set ws = ActiveSheet 
Set rngFirstRow = ws.Range("A1:NS1") 
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("A87").End(xlUp)) 
     .Header = xlYes 
     .MatchCase = False 
     .Apply 
    End With 
Next rng 

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("F4:F88"), _ 
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, _ 
    239, 206) 
With ActiveWorkbook.Worksheets("Sheet1").Sort 
    .SetRange Range("F3:F88") 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Application.ScreenUpdating = True 
End Sub 

要運行第二個模塊每次for循環完成：

Sub SortIndividualRows() 
' 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("A1:NS1") 
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("A87").End(xlUp)) 
     .Header = xlYes 
     .MatchCase = False 
     .Apply 
    End With 


ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("F4:F88"), _ 
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, _ 
    239, 206) 
With ActiveWorkbook.Worksheets("Sheet1").Sort 
    .SetRange Range("F3:F88") 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 

Next rng 

Application.ScreenUpdating = True 
End Sub