Question

我试图在B，C，D和E列的行中对值进行求和，并输出列k，l，m和n中的和值。标准与A列和J列之间的值相匹配。

对于具有相同编号的多个行条目，输出未正确获取总和。例如，对于A = 32605列中的特定单元格值，只有一个行条目具有以下值作为输入：

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，输入：

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

End Sub

希望得到你的帮助。如果需要更多信息，请告诉我。

谢谢。 MK

Answer 1

从您的示例中，您似乎正在尝试对数值使用通配符“模式匹配”。

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 中找到 123 来产生误报。

您的排序例程使列J与列K：O不同步。替换你拥有的东西，

' 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 property属性作为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"))

这应该补偿数字中发现的前导零 - 实际上是文本。

Excel VBA：如何根据匹配的值在行中添加单元格

1 个答案: