Excel VBA在宏中使用范圍

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

我嘗試將“行”放置在多個位置，但是出現了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，這只是錄制問題，不一定是您想要的。 但是你可以決定。

添加了用於進行小計的EDIT例程

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