Excel VBA SUMIF或SUMIFS多个标准

本文介绍了Excel VBA SUMIF或SUMIFS多个标准的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

我正在尝试从用户提供的日期范围中提取唯一的工作请求号码。将这些独特的工作请求号码放在列J中（与A列中的WR＃进行比较）。然后添加列J中找到的每个Unique WR＃的所有值（与A列值比较）和第一列中找到的值。对于此计算，我不必显示日期，只需要日期范围的唯一WR＃显示第一列的总和值。例如，如果整个数据集包含从2015年1月1日至2015年8月4日的值，并且用户将开始日期作为7/1/2015和结束日期为7/31/2015，唯一值列（J）应仅将列I中找到的唯一工作请求的值的总和输出到列K中。我迄今为止的努力不成功。代码写在下面，并且可以从以下链接找到具有数据和代码的excel文件： drive.google/file/d/0BzLiHD7QMfVldm1pSG1XaUdpcTQ/view?usp=sharing

I am trying to pull unique Work Request number from the user’s provided date range. Place these unique work request number in Column J (after comparing with WR# in column A). Then add all values for each Unique WR# found in Column J (comparing with column A values) and with values found in column I. For this calculation I don’t have to show the dates, only need Unique WR# for the date range showing the sum values from column I. For example, if entire data set contains values from January 1, 2015 to August 4, 2015, and the user enter start date as 7/1/2015 and end date as 7/31/2015, the Unique value column ("J") should output only the summation of unique work request's values found in column I into column K. My effort so far is not successful. Code is written below and the excel file with data and code can be found from the following link: drive.google/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

推荐答案

以下是根据要求进行更新的代码：

Here is the updated code that looks like working per the requirements:

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