我在VBA代碼中的操作順序有什麼問題？

Question

我有這個Excel電子表格，我試圖創建一個工作宏（在VBA中），當一個單元格包含一個日期（日期按B列中的一行排列），並且這個單元格是一種特定的顏色，此單元格處於活動狀態，並且用戶單擊某個按鈕時，宏將搜索與活動單元格中的日期和其顏色相等的所有日期。然後在H列中，將找到的日期各行的數值相加並存儲到名爲totalValue的變量中。然後將日期，描述和totalValue複製到另一個工作表並粘貼到下一個可用的預定義行。

我知道顏色排序適用於一種顏色，我使用多種顏色佈局。問題是，當我運行宏時，它似乎在日期內添加了H列中的所有數值，並且不會過濾掉顏色。但是，當我取出第52行的「如果顏色等於這個，然後做數學」的代碼塊（ElseIf rFound.Style.Name = "Shipping" Then totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"），那麼第49行的代碼的顏色值爲50（作品ElseIf rFound.Style.Name = "Office" Then totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"），但不是除非我拿出第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 & 53碼之前，我希望與我的解釋這有助於爲正在發生的事情：

這裏是一個圖片，取出的線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循環中引入條件語句來以更簡單且不太複雜的方式重寫它。