Excel VBA：如何根据匹配的值在行中添加单元格
我试图在列B，C，D和E中的行中求和值，并且输出列k，l，m和n中的和值。 标准与列A和J之间的值匹配
对于具有相同编号的多个行条目，输出没有正确地求和。 例如，对于列A = 32605中的特定单元格值，其中只有一行条目具有以下值作为input：
Pr Pl La Sc 0 1 0 0 输出正在列K，L，M和N：
Pr Pl La Sc 17 0 0 1
对于上面的例子，输出应该是：
Pr Pl La Sc 0 1 0 0
对于多个行条目示例，列A单元格值= 35092，input：
Pr Pl La Sc 0 1 0 0 0 2 0 0 0 1 0 0 0 3 0 0 0 2 0 0 0 1 0 0 0 1 0 0 84 0 0 7 0 2 0 0
输出显示为：
Pr Pl La Sc 0 4 0 0
正确的输出应该是：
Pr Pl La Sc 84 13 0 7
这里是完整的代码
Sub A1Report() ActiveSheet.Name = "AccessImport" ' 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:") If IsDate(TheString1) Then TheStartDate = DateValue(TheString1) Else MsgBox "Invalid date entered" End If TheString2 = Application.InputBox("Enter the end date:") If IsDate(TheString2) Then TheEndDate = DateValue(TheString2) Else MsgBox "Invalid date entered" End If ' The following code extracts the data for a specific date range provided by the user. ActiveSheet.ListObjects("Table_ARM_Activity_Tracker").Range.AutoFilter field:=7, Criteria1:=">=" & TheStartDate, Operator:=xlAnd, Criteria2:="<=" & TheEndDate ' The next block of code fills up all the blank cells found in column A with E4486 or 004486. 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 = "004486" End If Next c Columns("A:W").HorizontalAlignment = xlCenter Dim LastRowFrom As Long Dim LastRowTo As Long Dim i As Long, j As Long Dim temp As Long Dim found As Boolean 'determines the last row that contains data in column A LastRowFrom = Range("A" & Rows.Count).End(xlUp).Row ' Copy data from active sheet to another sheet ActiveWorkbook.Worksheets.Add ActiveSheet.Name = "DeanRoberts" Worksheets("AccessImport").Activate Dim mainworkBook As Workbook Set mainworkBook = ActiveWorkbook mainworkBook.Sheets("AccessImport").UsedRange.Copy mainworkBook.Sheets("DeanRoberts").Select mainworkBook.Sheets("DeanRoberts").Range("A1").Select mainworkBook.Sheets("DeanRoberts").Paste ' Find the unique values and place these identified unique values from Column A into Column J Worksheets("DeanRoberts").Activate 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) ' Clear contents after the last rows with values in column J Worksheets("DeanRoberts").Activate ' Sum values found in column B for each unique WR# in Column J, output the result on Column K, L, M, N Dim rowIndex As Long Dim calcFormula1 As Double Dim calcFormula2 As Double Dim calcFormula3 As Double Dim calcFormula4 As Double For rowIndex = 2 To lr2 calcFormula1 = Application.SumIf(Range("A:A"), "*" & Cells(rowIndex, "J").Value & "*", Range("B:B")) calcFormula2 = Application.SumIf(Range("A:A"), "*" & Cells(rowIndex, "J").Value & "*", Range("C:C")) calcFormula3 = Application.SumIf(Range("A:A"), "*" & Cells(rowIndex, "J").Value & "*", Range("D:D")) calcFormula4 = Application.SumIf(Range("A:A"), "*" & Cells(rowIndex, "J").Value & "*", Range("E:E")) Cells(rowIndex, "K").Value = calcFormula1 Cells(rowIndex, "L").Value = calcFormula2 Cells(rowIndex, "M").Value = calcFormula3 Cells(rowIndex, "N").Value = calcFormula4 Cells(rowIndex, "O").Value = calcFormula1 + calcFormula2 + calcFormula3 + calcFormula4 Next rowIndex For rowIndex = 2 To lr2 Cells(rowIndex, "P").Value = (Cells(rowIndex, "O").Value * 0.008) + 0.08 Next rowIndex ' Sort values, lowest to highest number WR# ActiveWorkbook.Worksheets("DeanRoberts").Sort.SortFields.Clear ActiveWorkbook.Worksheets("DeanRoberts").Sort.SortFields.Add Key:=Range( _ "J:J"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("DeanRoberts").Sort .SetRange Range("J:J") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Columns("J:J").EntireColumn.AutoFit Range("O1").Select Columns("O:O").EntireColumn.AutoFit Columns("P:P").EntireColumn.AutoFit ' Inserting title of the columns Cells(1, "J").Value = "WR#" Cells(1, "K").Value = "Prints" Cells(1, "L").Value = "Plots" Cells(1, "M").Value = "Laminate" Cells(1, "N").Value = "Scans" Cells(1, "O").Value = "Total Usage" Cells(1, "P").Value = "Total Hours" ' Cells(1, "P").Value = "Grand Total" 'Cells(2, "P").Value = calcTotal 'avgNumber = calcTotal / TotalDaysEntered 'Cells(1, "Q").Value = "Average" 'Cells(2, "Q").Value = avgNumber Cells(1, 10).Font.Bold = True Cells(1, 11).Font.Bold = True Cells(1, 12).Font.Bold = True Cells(1, 13).Font.Bold = True Cells(1, 14).Font.Bold = True Cells(1, 15).Font.Bold = True Cells(1, 16).Font.Bold = True Cells(1, 17).Font.Bold = True Cells(1, 18).Font.Bold = True Columns("A:W").HorizontalAlignment = xlCenter
结束小组
希望能得到你的帮助。 让我知道是否需要更多的信息。
谢谢。 MK
从你的例子来看，你似乎试图在数值上使用通配“模式匹配”。 该
Dim rowIndex As Long Dim calcFormula1 As Double Dim calcFormula2 As Double Dim calcFormula3 As Double Dim calcFormula4 As Double For rowIndex = 2 To lr2 calcFormula1 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Value, Range("B:B")) calcFormula2 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Value, Range("C:C")) calcFormula3 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Value, Range("D:D")) calcFormula4 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Value, Range("E:E")) Cells(rowIndex, "K").Value = calcFormula1 Cells(rowIndex, "L").Value = calcFormula2 Cells(rowIndex, "M").Value = calcFormula3 Cells(rowIndex, "N").Value = calcFormula4 Cells(rowIndex, "O").Value = calcFormula1 + calcFormula2 + calcFormula3 + calcFormula4 Next rowIndex
你的原始代码是通过在91234内部find123来产生误报。
您的sorting例程正在使列J与列K：O不同步。 replace你所拥有的这个，
' Sort values, lowest to highest number WR# With ActiveWorkbook.Worksheets("DeanRoberts") With .Cells(2, 10).CurrentRegion .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _ Orientation:=xlTopToBottom, Header:=xlNo End With End With
我也将使用Range.Text财产的sumifs。
calcFormula1 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Text, Range("B:B")) calcFormula2 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Text, Range("C:C")) calcFormula3 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Text, Range("D:D")) calcFormula4 = Application.SumIf(Range("A:A"), Cells(rowIndex, "J").Text, Range("E:E"))
这应该补偿数字即实际文本中的前导零。