基于一个值的总和，而不考虑另一个列中的重复项-Access或Excel

Question

我一直在根据“提交”是唯一的“键”列，对数据库中的“更正”总数求和。

我找到了一种计算excel中所需内容的方法，但是在VBA上使用时，该计算变得不切实际，因为要花5,000分钟才能运行9000行，这只是一个示例。

我发现的excel公式是具有COUNTIF的SUMPRODUCT，如下所示：

=SUMPRODUCT(($T$2:$T$40=T2)*$I$2:$I$40/COUNTIFS($N$2:$N$40,$N$2:$N$40)) (where T = Key; I= Corrections and N= Submissions)

由于我无法通过excel来减少添加到VBA中的时间，所以我想知道是否可以将其添加到从中获取原始数据的访问数据库中。

Answer 1

如果要在MS Access中完成此操作，可以使用以下查询：

select q.key, sum(q.corrections) as [Total of Corrections]
from (select distinct t.submission, t.corrections, t.key from YourTable t) q
group by q.key

（更改YourTable以适合您的表名）

如果您想将总计作为原始数据的一部分输出，请按照您的屏幕截图，使用：

select t.*, s.[total of corrections]
from YourTable t inner join 
(
    select q.key, sum(q.corrections) as [total of corrections]
    from (select distinct t.submission, t.corrections, t.key from YourTable t) q
    group by q.key
) s on t.key = s.key

（再次，更改两次出现的YourTable以适合您的表名）

Answer 2

根据要求，VBA是我第一次尝试创建类似这样的东西，所以请您原谅我的混乱，下面的所有内容都是使用类似这样的论坛进行汇总的，我只是对上面的情况有所了解，所以我决定增加列并分隔公式以在excel中工作。 我创建一个计数，以查找重复项并最终使用新列划分每个提交的更正总数。非常感谢您的帮助：

Sub ImportData()

Dim C_Sheet As String, C_LastRow As Long, D_LastRow As Long

C_Sheet = "ProductivityFinal"
C_LastRow = Sheets(C_Sheet).Range("N:N").End(xlDown).Row 'count col for Claim ID (no blank expected)
'C_LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Dim TmpFolder As String, TmpFile As String, BUfile As String

TmpFolder = "X:\Productivity Report\" 'live folder

TmpFile = "ProductivityFinal.xlsx"
BUfile = "BU_ProductivityFinal.xlsx"

If Dir(TmpFolder & TmpFile) = "" Then 'check if temp file exists
    MsgBox "No data file exists. Please run report."
Exit Sub
End If

If MsgBox("It may take some time. Closing unnecessary files would help to speed up." & vbCrLf & "Continue?", vbOKCancel) = vbCancel Then
    Exit Sub
End If

Sheets("Summary").Select
Call Shaper1
Range("A1").Select

Application.ScreenUpdating = False
Application.Calculation = xlManual

Workbooks.Open TmpFolder & TmpFile
D_LastRow = Cells(Rows.Count, 14).End(xlUp).Row

'Clearing data sheets before import
ThisWorkbook.Activate
Sheets(C_Sheet).Select
Call ClearTable1

'Fetch data and paste
Workbooks(TmpFile).Activate
    Sheets("ProductivityFinal").Select
    Range("A2:T" & D_LastRow).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
ThisWorkbook.Activate
    Sheets(C_Sheet).Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2").Select

'--Sorting--
Call SortingTable
'-----------




Workbooks(TmpFile).Activate

'Take backup and delete original temp file.
On Error Resume Next
Application.DisplayAlerts = False
Workbooks(TmpFile).SaveAs Filename:=TmpFolder & BUfile
Application.DisplayAlerts = True
Workbooks(BUfile).Close
On Error GoTo 0

Kill TmpFolder & TmpFile


Call HeaderAndFormula


Sheets("Summary").Select
Call RefreshingPivot
'--------------


Application.ScreenUpdating = True
'Application.Calculation = xlCalculationAutomatic

Call Shaper4
MsgBox "Updated"

End Sub

Sub HeaderAndFormula()

Dim C_Sheet As String, C_LastRow As Long
C_Sheet = "ProductivityFinal"

C_LastRow = Sheets(C_Sheet).Range("N:N").End(xlDown).Row
Sheets("Config").Range("B4").Value = C_LastRow

'Header
Sheets(C_Sheet).Range("A1:AE1").Value = Sheets("Config").Range("A10:AE10").Value

'Formulas

Sheets(C_Sheet).Range("A1").Select

Sheets(C_Sheet).Range("U2").Value = "=O2/I2"
Sheets(C_Sheet).Range("W2").Value = "=V2/G2"
Sheets(C_Sheet).Range("Z2").Value = "=X2*1"
Sheets(C_Sheet).Range("AA2").Value = "=TIMEVALUE(M:M)"
Sheets(C_Sheet).Range("AE2").Value = "=AA2-AB2-AD2"


Sheets(C_Sheet).Range("X2").Value = "=IF(P2=Q2,IF(T3=T2,IF(K3<J2,(K2-J2),""STARTED BEFORE SUBMITTING LAST CLAIM""),IF(P2=Q2,(K2-J2))),""Assigned Overnight"")"
Sheets(C_Sheet).Range("Y2").Value = "=IF(T3=T2,IF(J2-K3<0,""ERROR"",J2-K3),""FIRST CLAIM OF THE DAY"")"
Sheets(C_Sheet).Range("AB2").Value = "=SUMIF(T:T,T2,Z:Z)"
Sheets(C_Sheet).Range("AC2").Value = "=IF(Y2=""FIRST CLAIM OF THE DAY"", 0, Y2*1)"
Sheets(C_Sheet).Range("AD2").Value = "=SUMIF(T:T,T2,AC:AC)"

'Sheets(C_Sheet).Range("AF2").Value = "=I2/COUNTIFS(T:T,T2,N:N,N:N)"
Sheets(C_Sheet).Range("AF2").Value = "=I2/COUNTIFS($T$2:INDIRECT(""$T$"" & Config!$B$4),T2,$N$2:INDIRECT(""$N$"" & Config!$B$4),$N$2:INDIRECT(""$N$"" & Config!$B$4))"

'Sheets(C_Sheet).Range("V2").Value = "=SUMIF(T:T,T2,I:I)"
'Sheets(C_Sheet).Range("V2").Value = "=SUMPRODUCT(($T$2:INDIRECT(""$T$"" & Config!$B$4)=T2)*$I$2:INDIRECT(""$I$"" & Config!$B$4)/COUNTIFS($N$2:INDIRECT(""$N$"" & Config!$B$4),$N$2:INDIRECT(""$N$"" & Config!$B$4)))"

'Sheets(C_Sheet).Range("V2").Value = "=SUMIF(T:T,T2,AF:AF)"
Sheets(C_Sheet).Range("V2").Value = "=SUMIF($T$2:INDIRECT(""$T$"" & Config!$B$4),T2,$AF$2:INDIRECT(""$AF$"" & Config!$B$4))"


'Autofill
'N:14, U:21 , AF: 32
Range("U2:AF2").AutoFill Destination:=Range(Cells(2, 21), Cells(Rows.Count, 14).End(xlUp).Offset(0, 18))


Sheets("Summary").Select
Application.ScreenUpdating = True
Call Shaper2

Call Shaper3
Sheets("Summary").Select
Application.ScreenUpdating = False
Sheets(C_Sheet).Select


'Sheets("ProductivityFinal").Range("U:AF").Calculate
Sheets("ProductivityFinal").Range("U2:AF" & Cells(Rows.Count, 14).End(xlUp).Row).Calculate


'Recover Pivot Reference


Sheets("Summary").PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
    PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "ProductivityFinal!$A$1:$AE$" & C_LastRow, Version:=xlPivotTableVersion14)

End Sub
Sub ClearTable1()
Sheets("ProductivityFinal").Select
If Range("N2") = "" Then
Exit Sub
End If

Rows("2:1048561").Select
Selection.Delete Shift:=xlUp
Range("U2:AE2").ClearContents 'remove formula
Sheets("ProductivityFinal").Range("A2:T2").Value = Sheets("Config").Range("A15:T15").Value 'feed sample data
End Sub

Sub RefreshingPivot() 'all pivot tables
'Dim PT As PivotTable   
'Dim WS As Worksheet
'
'    For Each WS In ThisWorkbook.Worksheets
'        For Each PT In WS.PivotTables
'          PT.RefreshTable
'        Next PT
'    Next WS

'Sheets("Summary").PivotTables("PivotTable1").PivotCache.Refresh

ActiveWorkbook.RefreshAll

End Sub

Sub SortingTable() 'sort *** [Key](A to Z) first then [Since Dt](Z to A).

'Format cells----
Columns("J:K").Select
Selection.NumberFormat = "dd/mm/yyyy"
Columns("P:Q").Select
Selection.NumberFormat = "dd/mm/yyyy"
Columns("W:W").Select
Selection.NumberFormat = "0.00%"
Columns("X:AE").Select
Selection.NumberFormat = "hh:mm:ss"
'----


Range("A1:AE1").AutoFilter

ActiveWorkbook.Worksheets("ProductivityFinal").AutoFilter.Sort.SortFields.Clear

ActiveWorkbook.Worksheets("ProductivityFinal").AutoFilter.Sort.SortFields.Add _
    Key:=Range("T1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
    :=xlSortNormal
With ActiveWorkbook.Worksheets("ProductivityFinal").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

ActiveWorkbook.Worksheets("ProductivityFinal").AutoFilter.Sort.SortFields.Add _
    Key:=Range("J1"), SortOn:=xlSortOnValues, Order:=xlDescending, _
    DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("ProductivityFinal").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Range("A1:AE1").AutoFilter
End Sub
Sub Shaper1() 'Import logo to appear
Sheets("Summary").Shapes("Rectangle 13").Left = 500
End Sub
Sub Shaper2() 'Import logo to disappear
Sheets("Summary").Shapes("Rectangle 13").Left = 5000
Sheets("Summary").Shapes("Rectangle 13").Top = 100
End Sub
Sub Shaper3() 'Calc logo to appear
Sheets("Summary").Shapes("Rectangle 14").Left = 500
End Sub
Sub Shaper4() 'Calc logo to disappear
Sheets("Summary").Shapes("Rectangle 14").Left = 5000
Sheets("Summary").Shapes("Rectangle 14").Top = 100
End Sub