Excel VBA SUMIF或SUMIFS用于多个条件
我正在尝试从用户提供的date范围中提取唯一的工作请求编号。 将这些唯一的工作要求编号放在J栏（与A栏中的WR＃进行比较后）。 然后为列J中find的每个唯一WR＃添加所有值（与列A值比较）以及列I中的值。对于此计算，我不必显示date，只需要date范围内的唯一WR＃显示来自列I的总和值。例如，如果整个数据集包含从2015年1月1日至2015年8月4日的值，并且用户input开始date为2015年7月1日并且结束date为2015年7月31日，唯一值列（“J”）应该只输出在列I中find的唯一工作请求值的总和到列K中。到目前为止，我的努力并不成功。 代码写在下面，包含数据和代码的excel文件可以从以下链接中find： https : //drive.google.com/file/d/0BzLiHD7QMfVldm1pSG1XaUdpcTQ/view?usp=sharing
Sub SumIfTest() Worksheets("AccessExtract").Activate Dim startDate As Date Dim endDate As Date startDate = InputBox("Enter Start Date") endDate = InputBox("Enter End Date") ' Extract unique WR# Dim d2 As Object, c2 As Variant, i2 As Long, lr2 As Long Set d2 = CreateObject("Scripting.Dictionary") lr2 = Cells(Rows.Count, 1).End(xlUp).Row c2 = Range("A2:A" & lr2) For i2 = 1 To UBound(c2, 1) d2(c2(i2, 1)) = 1 Next i2 Range("J2").Resize(d2.Count) = Application.Transpose(d2.keys) Dim rowIndex As Long Dim calcFormula10 As Double For rowIndex = 2 To lr2 If ((Cells(rowIndex, "G").Value >= startDate) And (Cells(rowIndex, "G").Value <= endDate)) Then calcFormula10 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Text, Range("I:I")) End If Cells(rowIndex, "K").value = calcFormula10 Next rowIndex End Sub 这里是更新的代码，看起来像按要求工作：
Option Explicit Sub Report1() Application.DisplayAlerts = False ActiveWorkbook.Worksheets.Add With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _ "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\tmp\ReportLocation\data1.mdb" _ , _ "racker.mdb;Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Databa" _ , _ "se Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bu" _ , _ "lk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet" _ , _ " OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support C" _ , _ "omplex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Val" _ , "idation=False"), Destination:=Range("$A$1")).QueryTable .CommandType = xlCmdTable .CommandText = Array("2015 Activites") .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .SourceDataFile = _ "C:\tmp\ReportLocation\data1.mdb" .ListObject.DisplayName = "Activity_Tracker1" .Refresh BackgroundQuery:=False End With ' The following code renames the Active sheet to AccessImport ActiveSheet.Name = "AccessImport" ' **************************************** ' The following code update column G with required Date format Worksheets("AccessImport").Activate Range("G:G").NumberFormat = "mm-dd-yyyy" ' Get the start and end date from the user Dim TheString1 As String, TheString2 As String, TheStartDate As Date, TheEndDate As Date Dim TotalDaysEntered As Integer TheString1 = Application.InputBox("Enter the start date:") TheString2 = Application.InputBox("Enter the end date:") If IsDate(TheString1) And IsDate(TheString2) Then TheStartDate = DateValue(TheString1) TheEndDate = DateValue(TheString2) Else MsgBox "Invalid date entered" Exit Sub End If ' The following code extracts the data for a specific date range provided by the user. ActiveSheet.ListObjects("Activity_Tracker1").Range.AutoFilter field:=7, Criteria1:=">=" & TheStartDate, Operator:=xlAnd, Criteria2:="<=" & TheEndDate ' Copy data from active sheet to another sheet ActiveWorkbook.Worksheets.Add ActiveSheet.Name = "Report1" Worksheets("AccessImport").Activate Dim mainworkBook As Workbook Set mainworkBook = ActiveWorkbook mainworkBook.Sheets("AccessImport").UsedRange.Copy mainworkBook.Sheets("Report1").Select mainworkBook.Sheets("Report1").Range("A1").Select mainworkBook.Sheets("Report1").Paste ' The next block of code fills up all the blank cells found in column A with E4486 or 004486. Worksheets("Report1").Activate Dim c As Integer For c = 1 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & c).value = vbNullString Then Range("A" & c).value = 4486 End If Next c ' Aligning column A to W as Center horizontally. Columns("A:W").HorizontalAlignment = xlCenter Columns("F:F").EntireColumn.AutoFit Columns("G:G").EntireColumn.AutoFit Columns("H:H").EntireColumn.AutoFit 'Determines the last row that contains data in column A Dim LastRowFrom As Long LastRowFrom = Range("A" & Rows.Count).End(xlUp).Row ' Find the unique values and place these identified unique values from Column A into Column J Dim d2 As Object, c2 As Variant, i2 As Long, lr2 As Long Set d2 = CreateObject("Scripting.Dictionary") lr2 = Cells(Rows.Count, 1).End(xlUp).Row c2 = Range("A2:A" & lr2) For i2 = 1 To UBound(c2, 1) d2(c2(i2, 1)) = 1 Next i2 Range("J2").Resize(d2.Count) = Application.Transpose(d2.keys) ' Calculation Dim i As Long Dim token As String Dim value As Double Dim lastI As Long token = Worksheets(ActiveSheet.Name).Range("A2").value value = 0 For i = 2 To lastRow(ActiveSheet.Name) If token = Worksheets(ActiveSheet.Name).Range("A" & CStr(i)).value Then If CDate(Worksheets(ActiveSheet.Name).Range("G" & CStr(i)).value) >= TheStartDate And CDate(Worksheets(ActiveSheet.Name).Range("G" & CStr(i)).value) <= TheEndDate Then value = value + (Worksheets(ActiveSheet.Name).Range("B" & CStr(i)).value + Worksheets(ActiveSheet.Name).Range("C" & CStr(i)).value + Worksheets(ActiveSheet.Name).Range("D" & CStr(i)).value + Worksheets(ActiveSheet.Name).Range("E" & CStr(i)).value) * 0.008 + 0.08 End If Else Worksheets(ActiveSheet.Name).Range("I" & CStr(i - 1)).value = value lastI = i If CDate(Worksheets(ActiveSheet.Name).Range("G" & CStr(i)).value) >= TheStartDate And CDate(Worksheets(ActiveSheet.Name).Range("G" & CStr(i)).value) <= TheEndDate Then value = (Worksheets(ActiveSheet.Name).Range("B" & CStr(i)).value + Worksheets(ActiveSheet.Name).Range("C" & CStr(i)).value + Worksheets(ActiveSheet.Name).Range("D" & CStr(i)).value + Worksheets(ActiveSheet.Name).Range("E" & CStr(i)).value) * 0.008 + 0.08 End If token = Worksheets(ActiveSheet.Name).Range("A" & CStr(i)).value End If Next i If lastI = lastRow(ActiveSheet.Name) Then If CDate(Worksheets(ActiveSheet.Name).Range("G" & CStr(lastI)).value) >= TheStartDate And CDate(Worksheets(ActiveSheet.Name).Range("G" & CStr(lastI)).value) <= TheEndDate Then value = value + (Worksheets(ActiveSheet.Name).Range("B" & CStr(lastI)).value + Worksheets(ActiveSheet.Name).Range("C" & CStr(lastI)).value + Worksheets(ActiveSheet.Name).Range("D" & CStr(lastI)).value + Worksheets(ActiveSheet.Name).Range("E" & CStr(lastI)).value) * 0.008 + 0.08 End If End If Worksheets(ActiveSheet.Name).Range("I" & CStr(lastRow(ActiveSheet.Name))).value = value * 0.008 + 0.08 ' **************************************** ' The following code matches WR # between Column J and A and for the matched WR# it sums up values in column I. Dim calcFormula10 As Double Dim rowIndex As Long For rowIndex = 2 To lr2 calcFormula10 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Text, Range("I:I")) Cells(rowIndex, "K").value = calcFormula10 Next rowIndex ' Autofit column J, K and L Columns("J:J").EntireColumn.AutoFit Columns("K:K").EntireColumn.AutoFit Columns("L:L").EntireColumn.AutoFit ' Inserting title of the columns Cells(1, "J").value = "WR#" Cells(1, "K").value = "Total" ' Bolds texts in Cell(1, 10), (1, 11) and (1, 12) Cells(1, 10).Font.Bold = True Cells(1, 11).Font.Bold = True Cells(1, 12).Font.Bold = True ' Hide columns Columns("A:I").Hidden = True ' Delete empty cells based on values on J column Dim WS4 As Worksheet Dim LastCell As Range Dim LastCellRowNumber As Long Set WS4 = Worksheets("Report1") With WS4 Set LastCell = .Cells(.Rows.Count, "J").End(xlUp) LastCellRowNumber = LastCell.Row Rows(LastCellRowNumber + 1 & ":" & Rows.Count).Delete End With End Sub Private Function lastRow(sheet As String) As Long Dim ix As Long ix = Worksheets(sheet).UsedRange.Row - 1 + Worksheets(sheet).UsedRange.Rows.Count lastRow = ix End Function