Question

我需要在Excel 2007中创建一个将要排序的宏。我不知道会有多少行。我知道一种方法来查找行数和如何记录排序，但不知道如何一起使用这些代码。

Sub Sort()
'
' Sort Macro
'   *find the last row (assuming no more than 100000 rows)*
    Dim Row As Range
    Set Row = Range("A100000").End(xlUp).Select

'  *code written by recording my sort*
    Range("A1:G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B6376" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D2:D6376" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2:F6376" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:G6376")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

我试图将“Row”放在多个位置，但是我得到了RUn-time错误'424'对象必需。我需要这个变量来替换行号（6376），但不知道该怎么做。

我可以看到这些线的位置

Range("A1:G1").Select
Range(Selection, Selection.End(xlDown)).Select

正在选择工作簿的内容，这就是我想要的，我只是不知道如何动态地进行。

编辑：我想要排序和小计。这是录制的宏。我需要根据有多少行将6376更改为动态。

Sub Macro4()
'
' Macro4 Macro
'

'
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B6376" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D2:D6376" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2:F6376" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:G6376")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
End Sub

感谢。

Answer 1

不确定您的数据设置，您可以尝试以下操作，其中包括B，D和F列的简单排序例程，假设您的数据从A列开始（它也将在2003年运行，但我想这是这不是问题）。我没有在你的代码中包含下面的MatchCase，这是录音的问题，而不一定是你想要的;但你可以决定。

编辑添加小计的例程

EDIT2 标题参数已添加到排序

Option Explicit
Sub SortAndSubtotal()
    Dim RG As Range
    Dim WS As Worksheet

Set WS = Worksheets("Sheet2") '<--Change as needed
Set RG = WS.Range("a1").CurrentRegion

With RG
    .Sort key1:=.Columns(2), order1:=xlAscending, _
        key2:=.Columns(4), order2:=xlAscending, _
        key3:=.Columns(6), order3:=xlAscending, _
        Header:=xlYes, MatchCase:=False
    .Sort key1:=.Columns(1), order1:=xlAscending, Header:=xlYes
End With

'Note that I am just selecting a single cell in the range, since the range will
'  expand with each Subtotal.  One could also use
'  RG.CurrentRegion as the Range Object Expression, but you need to use it
'  individually for each .Subtotal operation, to handle the expansion issue.
'  Or you could use With RG and then prefix each Subtotal line with .CurrentRegion

With RG(1)
    .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7), _
        Replace:=True, SummaryBelowData:=True
    .Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7), _
        Replace:=False, SummaryBelowData:=True
    .Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
        Replace:=False, SummaryBelowData:=True
End With

End Sub

Answer 2

将“C2”中的“C”替换为您要排序的列。

ActiveWorkbook.Worksheets("Sheet1").UsedRange.Sort key1:=Range("C2"), _
  order1:=xlAscending, header:=xlYes

只需对整张纸进行排序。如果key1上的列不存在，您将收到错误，这很有意义;），所以请确保它。

Answer 3

<强> UNTESTED

试试吧。

Sub Sample()
    Dim thisWb As Workbook
    Dim ws As Worksheet
    Dim lRow As Long
    Dim rng As Range

    Set thisWb = ThisWorkbook

    '~~> Set this to the relevant sheet
    Set ws = thisWb.Sheets("Sheet2")

    With ws
        '~~> Find the last Row. See the below link for more details
        '~~> http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                               After:=.Range("A1"), _
                               Lookat:=xlPart, _
                               LookIn:=xlFormulas, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious, _
                               MatchCase:=False).Row
        Else
            lRow = 1
        End If

        '~~> Set your range
        Set rng = .Range("A1:G" & lRow)

        With .Sort.SortFields
            .Clear

            .Add Key:=ws.Range("B2:B" & lRow), SortOn:=xlSortOnValues, _
                 Order:=xlAscending, DataOption:=xlSortNormal

            .Add Key:=ws.Range("D2:D" & lRow), SortOn:=xlSortOnValues, _
                 Order:=xlAscending, DataOption:=xlSortNormal

            .Add Key:=ws.Range("F2:F" & lRow), SortOn:=xlSortOnValues, _
                 Order:=xlAscending, DataOption:=xlSortNormal
        End With

        With .Sort
            .SetRange ws.Range("A1:G" & lRow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    '~~> Work with the range
    With rng
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True

        .Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True

        .Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(7), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    End With
End Sub

使用宏中的范围的Excel VBA

3 个答案: