在指定范围内排序并循环直到完成 - VBA Excel宏

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 看看它的作用。