Question

在表格上＃34;所有＆＃34;我有数据范围，从A列到AC。每个范围的开始由包含＆＃34;＃＆＃34;的字符串定义。在A列中。下面的例程在每行上面插入一个空白行，用＆＃34;＃＆＃34;并根据降序中H列中的值对每个范围进行排序。最后，删除所有插入的空白行。

当我运行代码时，排序工作，但是，我收到错误消息＆＃34;范围类的排序方法失败＆＃34;在

.Range("A3").CurrentRegion.Offset(1, 0).Sort Key1:=Range("H4"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

请帮助改进以下代码，以免产生错误。

Sub SortRanges()

Dim LR As Long
Dim myCount As Long
Dim r As Long
Dim i As Long
Dim Rng As Range

Application.ScreenUpdating = False


With Sheets("all")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
Set Rng = .Range("A2:A" & LR)
With Rng

For i = LR To 1 Step -1

If InStr(Rng(i).Value, "#") > 0 Then
    Rng(i).Offset(0, 0).EntireRow.Insert

End If
Next
End With

.Range("A3").CurrentRegion.Offset(1, 0).Sort Key1:=Range("H4"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set Rng = .Range("A3").CurrentRegion

r = Rng(Rng.Count).Row
LR = .Range("A" & .Rows.Count).End(xlUp).Row
myCount = Application.WorksheetFunction.CountBlank(.Range("A1:A" & LR))

For i = 1 To myCount

.Range("A" & r).Offset(2, 0).CurrentRegion.Offset(1, 0).Sort Key1:=.Range("H4"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Set Rng = .Range("A" & r).Offset(2, 0).CurrentRegion

r = Rng(Rng.Count).Row

Next i

LR = .Range("A" & .Rows.Count).End(xlUp).Row

.Range("A1:A" & LR).AutoFilter Field:=1, Criteria1:="="

.Range("A2:AC" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilterMode = False
End With

Application.ScreenUpdating = True

End Sub

Answer 1

排序时无需插入空白行，您只需定义排序范围即可。下面的示例确定每个部分的范围并对其进行排序，直至第一个空单元格。

已编辑：添加逻辑以对除指定为已跳过

之外的所有工作表进行排序

Option Explicit

Sub test()
    '--- sort each section by column H
    Dim sh As Worksheet
    Dim section As Range
    Dim sortCol As Range
    Dim startRow As Long
    Dim numRows As Long
    Dim skipSheets As String

    skipSheets = "Sheet1,After Sort,Unsorted"

    For Each sh In ThisWorkbook.Sheets
        Debug.Print "------------------------------------------------------"
        Debug.Print "Checking sheet " & sh.Name & "... ";
        If InStr(1, skipSheets, sh.Name, vbTextCompare) = 0 Then
            Debug.Print "sorting!"
            Set section = sh.Range("A2:AC2")
            Do While True
                startRow = section.Row
                numRows = RowsInSection(startRow)
                Debug.Print vbTab & "section starting at row " & Format(startRow, "@@@") & _
                                    " with " & Format(numRows, "@@@") & " to sort: ";
                If numRows > 1 Then
                    '--- the section to sort does NOT include the first row
                    '    (with the "#" as the first character in column A)
                    '    so shift the section range down by one row and expand
                    '    to include all the rows
                    Set section = section.Offset(1, 0)
                    Set section = section.Resize(numRows - 1, section.Columns.Count)
                    '--- now set the column range on which to sort
                    Set sortCol = sh.Range("H" & startRow + 1, "H" & startRow + numRows - 1)
                    Debug.Print "range: " & section.Address;
                    Debug.Print " sort key: " & sortCol.Address
                    '--- finally sort it!
                    section.Sort Key1:=sortCol, Order1:=xlDescending, Header:=xlGuess, _
                                 OrderCustom:=1, MatchCase:=False, _
                                 Orientation:=xlTopToBottom
                End If
                Set section = section.Offset(numRows - 1, 0)
                If IsEmpty(section.Cells(1, 1)) Then
                    Exit Do
                End If
            Loop
        Else
            Debug.Print "skipped."
        End If
    Next sh
End Sub

Function RowsInSection(startRow As Long) As Long
    Dim i As Long
    i = startRow + 1
    Do While True
        If IsEmpty(Cells(i, 1)) Or Left(Cells(i, 1).Value, 1) = "#" Then
            Exit Do
        Else
            i = i + 1
        End If
    Loop
    RowsInSection = i - startRow
End Function

范围排序然后我得到＆＃34;排序范围类失败＆＃34;错误

1 个答案: