我希望通过构建宏来为用户进行排序和求和。宏需要找到最后一行,然后排序,然后是小计和总计。它还应该使用当前的活动表。例如,我应该将第一个电子表格转换为第二个:
我可以通过简单的宏录制来为这个数据集做到这一点。
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时可用。
如果可能的话,我还想对小计区域进行着色,但这是次要请求。
答案 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