Question

我有这个Excel电子表格，我正在尝试创建一个工作宏（在VBA中），当一个包含日期的单元格（按B列中的行按顺序排列日期），并且此单元格为特定颜色时，并且此单元格处于活动状态，并且用户单击按钮，宏将搜索所有等于活动单元格中日期及其颜色的日期。然后在H列中，将找到的日期各行的数值相加并存储到名为totalValue的变量中。然后，将日期，描述和totalValue复制到另一个在下一个可用的预定义行中粘贴并粘贴。

我知道颜色排序适用于一种颜色，我使用多种颜色布局。问题是当我运行宏时，它似乎在日期内添加了列H中的所有数字值，并且它不会过滤掉颜色。但是，当我拿出代码块“如果颜色等于这个，那就做数学”第52行＆amp; 53（ElseIf rFound.Style.Name = "Shipping" Then totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"）然后是第49行和第49行中代码的颜色值。 50个作品（ElseIf rFound.Style.Name = "Office" Then totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"），但不是第46行和第4行的代码。 47除非我拿出第49行和第49行的代码。也是50，否则它仍会添加E列中的所有值。

我做错了什么？如何修复它以便它能够以设定的颜色找到日期，并且能够使用多种设置颜色而不会出现此添加问题？

相关代码从'BEGINNING OF HELP SEGMENT开始，到'END OF HELP SEGMENT结束。 'BEGINNING of Search function for HELP SEGMENT和'ENG of Search function for HELP SEGMENT之间的上述代码是搜索参数的收集。

这是我的代码：

Sub Copy_and_Move_Jul()
'
' Copy_and_Move From July Payable Ledger to Jul Summary Macro
'

'BEGINNING of Search function for HELP SEGMENT
'********************************************
    'Declare Var

    Const AllUsedCellsColumnB = False
    Dim rFound As Range, SearchRange As Range
    Dim cellValue As Variant, totalValue As Variant

    ' Get the H value of active row and set it to totalValue
    cellValue = Range("H" & ActiveCell.Row)
    totalValue = cellValue

    ' GET & SEARCH FOR COLOR AND DATE OF ACTIVE CELL, AND GET THE VALUES IN COLUMN H AND RETURN VALUE TO "totalValue"

    ' set search range
    Set SearchRange = Range("B7:B56")

    ' If there is no search range, show Msg
    If Intersect(SearchRange, ActiveCell) Is Nothing Then
        SearchRange.Select
        MsgBox "You must select a cell in the date column before continuing", vbInformation, "Action Cancelled"
        Exit Sub
    End If

    ' Get search criteria & set it to rFound
    Set rFound = SearchRange.Find(What:=ActiveCell.Value, _
                                  After:=ActiveCell, _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  SearchFormat:=False)


'********************************************
ENG of Search function for HELP SEGMENT


' BEGINNING OF HELP SEGMENT
'********************************************************************************************************************

    ' If rFound is not Nothing, then do math. If rFound is Nothing, then findnext
    If Not rFound Is Nothing Then

        Do

            If rFound.Style.Name = "Marketing" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            ElseIf rFound.Style.Name = "Inventory" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            ElseIf rFound.Style.Name = "Office" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            ElseIf rFound.Style.Name = "Shipping" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            End If

            Set rFound = SearchRange.FindNext(rFound)

        ' Loop till all matching cells are found
        Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
    End If ' End of the Color & Date search
'********************************************************************************************************************    
' END OF HELP SEGMENT    

    'Select & copy Columns B - I of Row of Active Cell

    Range("B" & ActiveCell.Row & ":G" & ActiveCell.Row).Select
    Selection.Copy

    'Go to "Summary" Sheet & Paste data in next available empty Row

    Sheets("Summary").Select
    Range("B56").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste

    'Select Column D & delete unneeded Qty # and input a "y" for "Expsense"
    Range("D" & ActiveCell.Row).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "y"

    'Set Value of Column H

    Range("E" & ActiveCell.Row) = totalValue


    'Goto Column C, Check Cell Style and input where supplies came from

    Range("C" & ActiveCell.Row).Select

    If Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Marketing" Then
        ActiveCell.FormulaR1C1 = "Marketing Supplies"

    ElseIf Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Inventory" Then
        ActiveCell.FormulaR1C1 = "Inventory Supplies"

    ElseIf Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Office" Then
        ActiveCell.FormulaR1C1 = "Office Supplies"

    ElseIf Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Shipping" Then
        ActiveCell.FormulaR1C1 = "Shipping Supplies"

    End If

End Sub

这是一张图片，在取出第52行和第52行的代码之前53，我希望这有助于我解释发生了什么：

这是一张图片，在取出第52行和第52行的代码之后53，这是它应该做的：

提前多多欣赏！

Answer 1

首先检查搜索范围内的所有样式名称是否都具有预期值：

Sub styleNames()

    Dim cl As Range, SearchRange As Range

    Set SearchRange = Range("B7:B56")

    For Each cl In SearchRange
        If cl.Value <> vbNullString Then _
            Debug.Print " row: " & cl.Row & " style name: " & cl.Style.name
    Next cl

End Sub

如果他们这样做，那么您肯定知道您的代码是问题所在。尝试通过在for each循环中引入条件语句，以更简单，更简单的方式重写它。

我在VBA代码中的操作顺序有什么问题？

1 个答案: