我有一个日期列
01-june-16. Cashier1. 100. 36
01-june-16. Cashier2. 300. 58
02-juns-16. Cashier1. 500. 36
02-june-16. Cashiet1. 200. 65
02-june-16. Cashier2. 100. 54
我需要在每个日期的相应行中为每个收银员添加数据,所以6月首先我应该有(136 + 358)当天的交易。
答案 0 :(得分:2)
试试这段代码让我知道它是否有效。
BusinessConnectorNet
答案 1 :(得分:0)
我建议使用SUMIF
公式的两个解决方案,避免使用For...Next
,一次设置所需的值。两者都提供了保留公式或公式返回的值的选择。
假设:
B2
G2:G3
1.-数据范围内的总计
Sub Adding_Amount_by_Date()
Const kFmlTotDay As String = "=SUMIF(#rDate,#Date,#rAmount)" 'SUMIF formula to apply
Dim rDta As Range
Dim sFml As String
Dim rTmp As Range, sFld As String, bPos As Byte
Rem Set Data Range
Set rDta = ThisWorkbook.Sheets("DATA").Range("B2").CurrentRegion 'Update as required
Rem Working With Body Range (Data Range excluding Headers)
With rDta.Offset(1).Resize(-1 + rDta.Rows.Count)
Rem Reset Formula
sFml = kFmlTotDay
Rem Amount Range
sFld = "Amount" 'Update as required
bPos = WorksheetFunction.Match(sFld, rDta.Rows(1), 0)
Set rTmp = .Columns(bPos)
sFml = Replace(sFml, "#r" & sFld, rTmp.Address)
Rem Date Range
sFld = "Date" 'Update as required
bPos = WorksheetFunction.Match(sFld, rDta.Rows(1), 0)
Set rTmp = .Columns(bPos)
sFml = Replace(sFml, "#r" & sFld, rTmp.Address)
sFml = Replace(sFml, "#" & sFld, rTmp.Cells(1).Address(0, 1))
Rem Enter Daily Total (Formula or Value)
sFld = "Total.Daily" 'Update as required
bPos = WorksheetFunction.Match(sFld, rDta.Rows(1), 0)
.Columns(bPos).Formula = sFml 'Enter formula
.Columns(bPos).Value = .Columns(bPos).Value2 'Replace formula with values (comment this line to have keep the formulas)
End With
End Sub
2.-摘要范围中的总数
Sub Adding_Amount_by_Date_OutputRange()
Const kFmlTotDay As String = "=SUMIF(#rDate,#Date,#rAmount)" 'SUMIF formula to apply
Dim rOut As Range
Dim rDta As Range
Dim sFml As String
Dim rTmp As Range, sFld As String, bPos As Byte
Rem Reset Output Table Range
Set rOut = ThisWorkbook.Sheets("DATA").Range("G2").CurrentRegion 'Update as required
With rOut
If .Rows.Count > 1 Then
.Offset(1).Resize(-1 + rOut.Rows.Count).ClearContents
Set rOut = rOut.Cells(1).CurrentRegion
End If
End With
Rem Set Data Range
Set rDta = ThisWorkbook.Sheets("DATA").Range("B2").CurrentRegion 'Update as required
Rem Work With Data Range Body (excluding Headers)
With rDta.Offset(1).Resize(-1 + rDta.Rows.Count)
Rem Reset Formula
sFml = kFmlTotDay
Rem Amount Range
sFld = "Amount" 'Update as required
bPos = WorksheetFunction.Match(sFld, rDta.Rows(1), 0)
Set rTmp = .Columns(bPos)
sFml = Replace(sFml, "#r" & sFld, rTmp.Address)
Rem Date Range
sFld = "Date" 'Update as required
bPos = WorksheetFunction.Match(sFld, rDta.Rows(1), 0)
Set rTmp = .Columns(bPos)
sFml = Replace(sFml, "#r" & sFld, rTmp.Address)
sFml = Replace(sFml, "#" & sFld, rOut.Cells(2, 1).Address(0, 1))
End With
Rem List Unique Date in Output Range
With rOut
rDta.Columns(bPos).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rDta.Columns(bPos), _
CopyToRange:=.Cells(1), _
Unique:=True
.Worksheet.Names("Criteria").Delete
.Worksheet.Names("Extract").Delete
End With
Rem Enter Daily Total (Formula or Value)
Set rOut = rOut.Cells(1).CurrentRegion
With rOut.Offset(1).Resize(-1 + rOut.Rows.Count).Columns(2)
.Formula = sFml 'Enter formula
.Value = .Columns(bPos).Value2 'Replace formula with values (comment this line to have keep the formulas)
End With
End Sub
建议阅读以下页面以深入了解所使用的资源:
Excel functions (by category),Excel Objects,Range Object (Excel),Range.Offset Property (Excel),
Variables & Constants,WorksheetFunction Object (Excel),With Statement