简体   繁体   English

Excel VBA在宏中使用范围

[英]Excel VBA using Range in Macro

I need to create a macro in Excel 2007 that will sort. 我需要在Excel 2007中创建要排序的宏。 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. 我尝试将“行”放置在多个位置,但是出现了RUn-time错误“ 424”对象必需。 I need this variable to replace the row number (6376) but not sure how to do it. 我需要此变量来替换行号(6376),但不确定如何去做。

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. 我需要根据有多少行将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

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). 不确定您的数据设置如何,您可以尝试以下操作,其中包括针对B,D和F列的简单排序例程,假设您的数据从A列开始(它也将在2003年运行,但是我想这不是问题)。 I did not include MatchCase below as in your code, it was a matter of the recording, and not necessarily what you want; 我没有在您的代码中包含MatchCase,这只是录制问题,不一定是您想要的。 but you can decide. 但是你可以决定。

EDIT Routine for doing subtotals added 添加了用于进行小计的EDIT例程

EDIT2 Header parameter added to Sort 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

Replace "C" in "C2" with the column you want to sort on. 用要排序的列替换“ C2”中的“ C”。

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. 如果key1的列不存在,则会出现错误;这很有意义;),因此请确保确实存在。

UNTESTED 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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

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