对不同大小的电子表格进行排序和求和

时间:2015-10-12 19:14:09

标签: excel vba excel-vba

我希望通过构建宏来为用户进行排序和求和。宏需要找到最后一行,然后排序,然后是小计和总计。它还应该使用当前的活动表。例如,我应该将第一个电子表格转换为第二个:

Pre and Post Spreadsheet

我可以通过简单的宏录制来为这个数据集做到这一点。

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
'
    ActiveWorkbook.Worksheets("Oct 2015").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Oct 2015").Sort.SortFields.Add Key:=Range("A2:A24" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Oct 2015").Sort.SortFields.Add Key:=Range("B2:B24" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Oct 2015").Sort
        .SetRange Range("A1:C24")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Range("A1:C45").Select
End Sub

我有以下一些代码来查找最后一行,但不知道如何将其集成到上面以替换硬编码的“范围”值。

 Sub GetLastRow(strSheet, strColum)
 Dim MyRange As Range
 Dim lngLastRow As Long

    Set MyRange = Worksheets(strSheet).Range(strColum & "1")

    lngLastRow = Cells(sheetvar.Rows.Count, MyRange.Column).End(xlUp).Row
 End Sub

我还需要将Active Worksheet值更改为当前打开的工作表,因为此值将更改。

列名和列顺序应该一致。我还需要将此脚本放在远程用户的PC上,并确保它们在打开Excel时可用。

如果可能的话,我还想对小计区域进行着色,但这是次要请求。

1 个答案:

答案 0 :(得分:-1)

你在那里一半。 首先,声明当前工作表,范围以及最后一行和列的变量。 然后将所有这些实现到刚刚录制的宏中。

 Sub Macro1()
    '
    ' Macro1 Macro
    '
    ' Keyboard Shortcut: Ctrl+Shift+B


    Dim sht As Worksheet
        Dim lRow As Long, lCol As Long
        Dim rng As Range
 Set sht = ActiveWorkbook.ActiveSheet
    With sht

            lRow = .Range("A" & .Rows.Count).End(xlUp).Row
            lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
      Set rng = .Range(.Cells(lRow, 1), .Cells(lRow, lCol))
    End With

        sht.Sort.SortFields.Clear
        sht.Sort.SortFields.Add Key:=rng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        sht.Sort.SortFields.Add Key:=rng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With sht.Sort
            .SetRange rng
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3), _
            Replace:=False, PageBreaks:=False, SummaryBelowData:=True

    End Sub