Суммируйте итоговое значение столбца на основе значения, не учитывая дубликат в другом столбце - доступ или превосходство

Question

Я искал способ суммирования общего количества «исправлений» в базе данных на основе столбца «ключ», где «представления» являются уникальными.

Я нашел способ рассчитать то, что мне нужно, в Excel, но при использовании на VBA вычисление становится непрактичным, так как он занимает более 50 минут, чтобы выполнить серию из 9000 строк, и это всего лишь пример.

Формула Excel, которую я нашел, это SUMPRODUCT с COUNTIF, как показано ниже:

=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