Что не так с моим порядком операций в коде VBA?

У меня есть электронная таблица Excel, что я пытаюсь создать рабочий макрос (в VBA), который, когда ячейка содержит дату (датируется порядком по строке в столбце B), и эта ячейка имеет определенный цвет, а эта ячейка активен, и пользователь нажимает кнопку, макрос ищет все даты, соответствующие дате в активной ячейке и ее цвету. Затем в столбце H totalValue значение соответствующих строк к найденным датам складывается и сохраняется в переменной под названием totalValue Затем потом дата, описание и totalValue копируются на другой лист и вставляются в следующий доступный предопределенный ряд.

Я знаю, что сортировка цвета работает для одного цвета, я использую несколько цветов. Проблема в том, что когда я запускаю макрос, он, кажется, добавляет все значения количества в столбце H в течение даты и не отфильтровывает цвета. Но, когда я вынимаю блок кода для «если цвет равен этому, а затем делать математику» в строках 52 и 53 ( 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" , но не код выше строки 46 и 47, если я не вычеркиваю код в строках 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, это то, что он должен делать:

результат строк 52 и 53 из кода

Очень благодарен заранее!

Начните с проверки, имеют ли все имена стиля в диапазоне поиска ожидаемые значения:

 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 цикла.

Interesting Posts

Блокировка листов Excel на основе флажков

Формула автоматически появляется

В Excel, используя OpenXML, как вы изменяете значение флажка в C #?

Загрузка Rails xls, сохранение xlsx

Вычисление недельных возвратов из ежедневных рядов цен

Расчет в реальном времени Excel в PowerPoint

Список, содержащий разные данные, которые будут отображаться в excel

Ошибка 424 внутри Если используется смещение

Развертывание служб Windows Microsoft.office.interop.excel нет доступа к файлам

У меня есть код для размещения всего содержимого различных .txt-файлов в Excel 2010, но вам нужны некоторые изменения

Активная колонка VLookup VBA для автозаполнения

Номера диаграмм в Excel со строками, смешанными в

Как ссылаться на открытый лист Excel, который я не знаю имени?

Попытка загрузить Excel в Struts1.3 с помощью Apache Poi. Не работает со второго запроса

Как заблокировать данные на листе Excel с помощью POI, оставляя ячейки без каких-либо данных / остальная часть листа разблокирована

Давайте будем гением компьютера.