简体   繁体   中英

Excel VBA using Range in Macro

I need to create a macro in Excel 2007 that will sort. I don't know how many rows there will be. I know one way to to find the number of rows and how to record sorting, but not how to use these bits of code together.

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

I've tried to put "Row" in multiple places, but I get the RUn-time error '424' Object Required. I need this variable to replace the row number (6376) but not sure how to do it.

I can see where these lines

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

are selecting the contents of the workbook, which is what I want, I just don't know how to do it dynamically.

EDIT: I want to sort and subtotal. This is the recorded macro. I need to change the 6376 to be dynamic according to how many rows there are.

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

Thanks.

Not being certain of your data setup, you can try the following, which includes a simple sort routine for columns B, D and F, assuming your data starts in column A (it will also run in 2003, but I guess that's not an issue). I did not include MatchCase below as in your code, it was a matter of the recording, and not necessarily what you want; but you can decide.

EDIT Routine for doing subtotals added

EDIT2 Header parameter added to Sort

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

Replace "C" in "C2" with the column you want to sort on.

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

Just sorts the whole sheet. You will get an error if the column at key1 does not exist, which makes pretty sense ;), so make sure it does.

UNTESTED

Try this for me.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM