在指定范圍內排序並循環直到完成 - VBA Excel Marcro

Question

又是我。 我一直在嘗試不同的替代方法來根據每個集合的 Col D 對行進行排序。

這是最接近的一個，但發現了 2 個錯誤。

1- 循環並且在到達最后使用的行時無法退出。 它一直在排序，直到我按下強制退出 2- 它無法對每個系列只有一個 SKU 的地方進行排序 它也對下一個系列進行排序。 有時對 3 個集合進行排序。 例如，在運行之前 - 第 9、29、32、35、45 行......

這是我的代碼。 我的代碼有什么問題？

Sub SortingCollectionOnColD
With ActiveSheet.Range("A:A")
    Set FindSubtotal = .Find("Subtotal", After:=.Range("A1"), LookIn:=xlValues)
        If Not FindSubtotal Is Nothing Then
            firstOne = FindSubtotal.Address
            Do
                With FindSubtotal
                        Range("A" & FindSubtotal.Row - 1).Select
                        Set SortRange = Range(Selection, Selection.End(xlUp)).EntireRow
                        ActiveSheet.Sort.SortFields.Clear
                            ActiveSheet.Sort.SortFields.Add Key:=Range("C" & FindSubtotal.Row) _
                                , SortOn:=xlSortOnValues, Order:=xlAscending
                            With ActiveSheet.Sort
                                .SetRange SortRange
                                .Header = xlNo
                                .Orientation = xlTopToBottom
                                .Apply
                            End With
                End With
                Set FindSubtotal = .FindNext(FindSubtotal)
            Loop While Not FindSubtotal Is Nothing And FindSubtotal.Address <> firstOne
        End If
End With End Sub

跑前

預期結果

跑完后。 突出了主要的失敗

Answer 1

請測試下一個代碼。 我無法復制你的工作表，我改變了對工作表的引用而不是 A:A 范圍，在我看來它看起來很合乎邏輯，但不太清楚你想要做什么，不返回你需要的內容並非不可能. 請讓我知道它是否/如何滿足您的需要。

Sub LoopSubtotal()
  Dim FindSubtotal As Range, sh As Worksheet, firstOne As String
  Dim SortRange As Range
   Set sh = ActiveSheet
   With sh.Range("A:A")
    Set FindSubtotal = .Find("Subtotal", After:=.Range("A1"), LookIn:=xlValues)
    If Not FindSubtotal Is Nothing Then
            firstOne = FindSubtotal.Address
            Do
                sh.Range("A" & FindSubtotal.row - 1).Select
                Set SortRange = Range(Selection, Selection.End(xlUp)).EntireRow
                sh.Sort.SortFields.Clear
                    sh.Sort.SortFields.Add Key:=sh.Range("C" & FindSubtotal.row) _
                        , SortOn:=xlSortOnValues, Order:=xlAscending
                    With sh.Sort
                        .SetRange SortRange
                        .Header = xlNo
                        .Orientation = xlTopToBottom
                        .Apply
                    End With
                    Set FindSubtotal = .FindNext(FindSubtotal): Debug.Print FindSubtotal.Address
            Loop While Not FindSubtotal Is Nothing And FindSubtotal.Address <> firstOne
        End If
   End With
End Sub

請嘗試，逐行運行它，按 F8 並查看它的作用。