Excel VBA с использованием Range в Macro

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» в нескольких местах, но я получаю ошибку времени выполнения «424» Требуется объект. Мне нужна эта переменная, чтобы заменить номер строки (6376), но не уверен, как это сделать.

я могу видеть, где эти линии

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

выбирает содержание книги, которая является то, что я хочу, я просто не знаю, как сделать это динамически.

EDIT: Я хочу отсортировать и переделать. Это записанный макрос. Мне нужно изменить 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

Замените «C» в «C2» на колонку, которую вы хотите отсортировать.

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