使用macros中的范围的Excel VBA

我需要在Excel 2007中创build一个macros来进行sorting。 我不知道会有多less行。 我知道一种方法来查找行数和如何loggingsorting，但不知道如何将这些代码一起使用。

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时间错误“424”对象需要。 我需要这个variables来replace行号（6376），但不知道如何去做。

我可以看到这些行

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

正在select工作簿的内容，这是我想要的，我只是不知道如何dynamic地做到这一点。

编辑：我想sorting和小计。 这是录制的macros。 我需要根据有多less行，将6376更改为dynamic。

 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的sorting例程，假设你的数据从列A开始（它也将在2003年运行，但我想这不是一个问题）。 我在下面的代码中没有包含MatchCase，这是录音的问题，不一定是你想要的。 但你可以决定。

编辑例程添加小计

EDIT2标题参数添加到sorting

 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”replace为您想要sorting的列。

 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