列中每个日期的总和数据

时间:2016-11-25 04:38:22

标签: excel vba date

我有一个日期列

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)当天的交易。

2 个答案:

答案 0 :(得分:2)

试试这段代码让我知道它是否有效。

BusinessConnectorNet

答案 1 :(得分:0)

我建议使用SUMIF公式的两个解决方案,避免使用For...Next,一次设置所需的值。两者都提供了保留公式或公式返回的值的选择。

假设:

  • 数据从B2
  • 开始
  • 数据包含以下标题:日期,收银员,金额
  • 添加标题:Total.Daily以显示所需的结果
  • 第二个解决方案假设结果摘要从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 ObjectsRange Object (Excel)Range.Offset Property (Excel)

Variables & ConstantsWorksheetFunction Object (Excel)With Statement