如何阻止宏自行取消分组和隐藏行

Question

我使用下面的代码对带有各种小计的电子表格进行排序。在6个电子表格中的5个，它按预期工作。在第6个电子表格中，我遇到了Excel从子组中取消组合行的问题。在下面的示例中，行435从组的其余部分移除，行436的高度减小到0.我查看了行435和436中的每个单元格，并且每个单元格与组中的其他行匹配。在与手动记录排序宏的用户交谈后，他们告诉我，有时他们的电子表格也会发生。这个宏适用于它必须排序的前27个组。我遇到问题的子组有95行，其他有更多行的组没有问题。

之前有没有人遇到过这个问题，有没有人想出如何处理它？<​​/ p>

我正在使用的代码如下。

Sub mcrFindSortGroup()

Dim strFirstRow As String
Dim strLastRow As String
Dim LastCol As Integer
Dim c As Range
Dim strColumn As String
Application.DisplayAlerts = False
Application.EnableCancelKey = xlDisabled

    Sheets("DCL Descriptions").Select
    Range("H2:H2").Select

strColumn = ActiveCell
strColumn = strColumn - 1

    Sheets("Sku Selling").Select

Columns("C:C").Select

For Each c In Range("DCL")
If c = "" Then GoTo DoneMsg

Cells(ActiveCell.Row, 1).Select

    Range("C1:C15000").Activate
    Selection.Find(What:=c, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

strFirstRow = ActiveCell.Row

Cells(ActiveCell.Row, 2).Select
If Cells(ActiveCell.Row + 1, 2) <> Cells(ActiveCell.Row, 2) Then
strLastRow = ActiveCell.Row

GoTo SkipSort

End If

Range(Selection, Selection.End(xlDown)).Select

strLastRow = ActiveCell.End(xlDown).Select
strLastRow = ActiveCell.Row

RowCount = (strLastRow - strFirstRow) + 1

    Rows(strFirstRow & ":" & strLastRow).Select
    ActiveWorkbook.Worksheets("Sku Selling").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Sku Selling").Sort.SortFields.Add Key:=ActiveCell _
    .Offset(0, strColumn).Range("A" & 1 & ":A" & RowCount) _
    , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sku Selling").Sort
        .SetRange ActiveCell.Range("A" & 1 & ":ZZ" & RowCount)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With

SkipSort: ' the group has only 1 sku and does not need to be sorted

    Next

DoneMsg:
MsgBox "Sorting Completed!", vbInformation, "Done"
Application.DisplayAlerts = True
Application.EnableCancelKey = xlErrorHandler
End Sub

这些是在屏幕截图之前和之后

在：

在：