Цитирование по динамическим диапазонам на другом листе для строк с определенным текстом в VBA

У меня есть макрос, который многое делает для создания отчета. Его шаблон с именем «Отчет», который имеет пользователя, добавляет другой лист через GetOpenFile с данными для анализа. Цель состоит в том, чтобы пользователь открыл книгу, нажал кнопку, выделил файл и сформировал полный отчет.

Лист данных, импортированный и переименованный в «Источник», содержит строку заголовков и переменно длинный список рабочих заказов. Каждая строка содержит ссылку на код продукта и несколько ссылок на статус заказа. У меня есть часть макроса, вытягивающего коды продукта из столбца источника O и сортировки по алфавиту без дубликатов.

Sub ReportBuilder() 'Variables for opening and copying the Sourcesheet, building and formatting the report. Dim sImportFile As String, sFile As String, cellName As String Dim sThisBk As Workbook, wbBk As Workbook Dim wSheet As Worksheet, sSheet As Worksheet, keepThis As Worksheet Dim nameRange As Range, orderRange As Range Dim rowCounterW As Integer, rowCounterS As Integer, pediCounter As Integer, adhoCounter As Integer, workCounter As Integer, holdCounter As Integer 'Turns off display of screen updates and alerts. Application.ScreenUpdating = False Application.DisplayAlerts = False 'Removes all but the summary sheet "Report". For Each keepThis In Application.ActiveWorkbook.Worksheets If keepThis.Name <> "Report" Then keepThis.Delete End If Next 'Displays an open file dialog box for selecting the target Source file. Set sThisBk = ActiveWorkbook sImportFile = Application.GetOpenFilename( _ FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Select a file saved from Source") 'Handles no sheet selection. If sImportFile = "False" Then MsgBox "No File Selected!" Exit Sub 'Opens the targeted file and copies the sheet. Else sFile = Dir(sImportFile) Application.Workbooks.Open fileName:=sImportFile Set wbBk = Workbooks(sFile) With wbBk Set wSheet = .Sheets("Sheet1") wSheet.Copy after:=sThisBk.Sheets("PBUS Report") ActiveSheet.Name = "Source" Sheets("PBUS Report").Activate wbBk.Close SaveChanges:=False End With End If 'Clears everything below the headers. Worksheets("Report").Rows(7 & ":" & Worksheets("Report").Rows.Count).Delete 'Inserts the list of unique PRODICT CODEs from the Source sheet. Set wSheet = Worksheets("Report") Set sSheet = Worksheets("Source") sSheet.Activate sSheet.Range("O2", Cells(Rows.Count, "O").End(xlUp)).Copy wSheet.Activate wSheet.Range("B7").PasteSpecial 'Sorts and adjusts after paste, also captures the range of PRODUCT CODEs. Selection.Interior.Color = xlNone Selection.Font.Bold = False wSheet.Columns("B:B").EntireColumn.AutoFit Application.Selection.RemoveDuplicates Columns:=1, Header:=xlNo Set nameRange = wSheet.Range("B7", Cells(Rows.Count, "B").End(xlUp)) nameRange.Sort key1:=ActiveCell, order1:=xlAscending 

Эта часть отлично работает, я получаю уникальный и алфавитный список кодов продуктов из столбца источника O, начиная со строки 2 в столбце отчета B, начиная со строки 7.

Я застрял в цикле, который подсчитывает строки в исходном листе. Для каждого уникального кода продукта в отчете (столбец B, начинающийся с 7) мне нужно подсчитать количество строк в источнике (столбец O, начинающийся с 2), где код соответствует И еще один столбец содержит описание состояния. Описания являются либо «Завод», либо «Хранение» в столбце «Источник» Z, или «Рабочий» или «Холдинг» в столбце «Источник». В них больше описаний, но я отслеживаю только эти 4 кода продукта.

  'Loop through the range of PRODUCT CODEs to build report. Set orderRange = sSheet.Range("O2", sSheet.Cells(Rows.Count, "O").End(xlUp)) rowCounterW = 7 'Starting offset for populating the report. For Each c In nameRange.Rows pediCounter = 0 'Counter for pedigree column. adhoCounter = 0 'Counter for ad-hoc column. workCounter = 0 'Counter for working column. holdCounter = 0 'Counter for hold column. cellName = c.Value For Each d In orderRange.Rows rowCounterS = orderRange.Row + 1 If sSheet.Cells(rowCounterS, "O") = cellName Then 'If the program name matches on both sheets. If sSheet.Cells(rowCounterS, "Z") = "Plant" Then pediCounter = pediCounter + 1 'Counts for pedigree column. End If If sSheet.Cells(rowCounterS, "Z") = "Storage" Then adhoCounter = adhoCounter + 1 'Counts for ad-hoc column. End If If sSheet.Cells(rowCounterS, "C") = "Working" Then workCounter = workCounter + 1 'Counts for working column. End If If sSheet.Cells(rowCounterS, "C") = "Holding" Then holdCounter = holdCounter + 1 'Counts for hold column. End If End If Next d wSheet.Cells(rowCounterW, "C") = pediCounter wSheet.Cells(rowCounterW, "D") = adhoCounter wSheet.Cells(rowCounterW, "E") = wSheet.Cells(rowCounterW, "C") + wSheet.Cells(rowCounterW, "D") wSheet.Cells(rowCounterW, "F") = workCounter wSheet.Cells(rowCounterW, "G") = holdCounter wSheet.Cells(rowCounterW, "H") = wSheet.Cells(rowCounterW, "E") + wSheet.Cells(rowCounterW, "F") + wSheet.Cells(rowCounterW, "G") rowCounterW = rowCounter + 1 Next c 

Эта итерация не учитывается или заполняется правильно, но она компилируется. Он заполняет только строку B7 0 и отказывается. Я пытаюсь выполнить:

  For Each "product code" in "range of product codes" on Report For Each row on Source starting at 2 If "that row" contains a matching "product code" from Report And If "that row" also contains "desired status1" Add 1 to counter for "desired status1" And If "that row" also contains "desired status2" Add 1 to a counter for "desired status2" etc... Populate Report column C with status 1 from the counter Populate Report column D with status 2 from the counter etc... Next "product code" 

Как я это испортил? Пробывая весь день с вариациями этого синтаксиса, когда-то все поля заполнялись номерами состояний, но все они были как 0, так и первая строка. В настоящее время происходит только заполнение 0-го уровня. Я не понимаю, почему динамический диапазон работал один раз, чтобы получить уникальный список кодов продуктов один раз, но не на следующем шаге к циклу.

EDIT: Поймал опечатку с rowCounterW в нижней части, которая остановила ее от циклического повтора. Также заменяет некоторые переменные, чтобы лучше подсчитывать строки в исходном листе. Работая следующим образом:

  'Loop through the range of PRODUCT CODEs to build report. rowCounterW = 7 'Starting offset for populating the report. For Each c In nameRange pediCounter = 0 'Counter for pedigree column. adhoCounter = 0 'Counter for ad-hoc column. workCounter = 0 'Counter for working column. holdCounter = 0 'Counter for hold column. cellName = c.Value For i = 2 To sSheet.Cells(Rows.Count, 2).End(xlUp).Row If sSheet.Cells(i, "O") = cellName Then 'If the program name matches on both sheets. If sSheet.Cells(i, "Z") = "Plant" Then pediCounter = pediCounter + 1 'Counts for pedigree column. End If If sSheet.Cells(i, "Z") = "Storage" Then adhoCounter = adhoCounter + 1 'Counts for ad-hoc column. End If If sSheet.Cells(i, "C") = "Working" Then workCounter = workCounter + 1 'Counts for working column. End If If sSheet.Cells(i, "C") = "Holding" Then holdCounter = holdCounter + 1 'Counts for hold column. End If End If Next i 'Populates the report after parsing every row. wSheet.Cells(rowCounterW, "C") = pediCounter wSheet.Cells(rowCounterW, "D") = adhoCounter wSheet.Cells(rowCounterW, "E") = wSheet.Cells(rowCounterW, "C") + wSheet.Cells(rowCounterW, "D") wSheet.Cells(rowCounterW, "F") = workCounter wSheet.Cells(rowCounterW, "G") = holdCounter wSheet.Cells(rowCounterW, "H") = wSheet.Cells(rowCounterW, "E") + wSheet.Cells(rowCounterW, "F") + wSheet.Cells(rowCounterW, "G") rowCounterW = rowCounterW + 1 Next c 

Извините, я не нашел времени, чтобы соответствовать вашим переменным, но у меня нет времени его исправить (мои работы с проектами / людьми / часами) …

Я бы начал с определения нескольких структур данных:

 Type ZCOType WBS As String ActivityType As String EmployeeName As String ProductionOrder As String Hours As Double End Type Type WeeklyManpower StartDate As Date EndDate As Date Hours As Double People As Long Data() As ZCOType DataCount As Long End Type Public g_ManpowerData() As WeeklyManpower, g_ManpowerCount As Long 

… Прочитайте данные в виде массива (для скорости)

 Dim vData vData = sSheet.Range("O2", Cells(Rows.Count, "O").End(xlUp)) 

… Цикл через массив vData более менее похож на то, что он совпадает с циклом через строки и столбцы и присваивает значения структуре данных

 For iRow = 2 To iLastRow ' Search for an data entry, with the same Start Date For Index = 0 to g_ManpowerCount -1 If StartDate = vData(iRow,1) then exit for Next Index ' If not found, create a new Record if Index >= g_ManpowerCount then ReDim Preserve g_ManpowerData(g_ManpowerCount) g_ManpowerData(Index).StartDate = vData(irow,1) g_ManpowerCount = g_ManpowerCount + 1 end if ' With g_ManpowerData(Index) ReDim Preserve .Data(.DataCount) With .Data(.DataCount) .EmployeeName = vData(irow,5) '.... End With .DataCount=.DataCount+1 End With Next 

Используйте функцию сортировки сортировки для сортировки списка :

 Public Sub QuickSortManpower(ManpowerData() As WeeklyManpower, intBottom As Integer, intTop As Integer) 

Приготовьтесь сбрасывать данные обратно в электронную таблицу, помещая их в массив Variant :

 Dim vProjectedData ReDim vProjectedData(g_ManpowerCount,7) For i = 0 To g_ManpowerCount vProjectedData(i, 1) = ManpowerData(i).StartDate vProjectedData(i, 2) = ManpowerData(i).EndDate vProjectedData(i, 3) = ManpowerData(i).Hours '... Next 

И, наконец, сбросьте значения на лист

 Sheet.Cells(2, 1).Resize(Rows + 1, 8) = vProjectedData 

Добавьте заголовки / форматирование по мере необходимости …

Поймал опечатку с rowCounterW в нижней части, которая остановила ее от циклического повторения. Также заменяет некоторые переменные, чтобы лучше подсчитывать строки в исходном листе. Работая следующим образом:

  'Loop through the range of PRODUCT CODEs to build report. rowCounterW = 7 'Starting offset for populating the report. For Each c In nameRange pediCounter = 0 'Counter for pedigree column. adhoCounter = 0 'Counter for ad-hoc column. workCounter = 0 'Counter for working column. holdCounter = 0 'Counter for hold column. cellName = c.Value For i = 2 To sSheet.Cells(Rows.Count, 2).End(xlUp).Row If sSheet.Cells(i, "O") = cellName Then 'If the program name matches on both sheets. If sSheet.Cells(i, "Z") = "Plant" Then pediCounter = pediCounter + 1 'Counts for pedigree column. End If If sSheet.Cells(i, "Z") = "Storage" Then adhoCounter = adhoCounter + 1 'Counts for ad-hoc column. End If If sSheet.Cells(i, "C") = "Working" Then workCounter = workCounter + 1 'Counts for working column. End If If sSheet.Cells(i, "C") = "Holding" Then holdCounter = holdCounter + 1 'Counts for hold column. End If End If Next i 'Populates the report after parsing every row. wSheet.Cells(rowCounterW, "C") = pediCounter wSheet.Cells(rowCounterW, "D") = adhoCounter wSheet.Cells(rowCounterW, "E") = wSheet.Cells(rowCounterW, "C") + wSheet.Cells(rowCounterW, "D") wSheet.Cells(rowCounterW, "F") = workCounter wSheet.Cells(rowCounterW, "G") = holdCounter wSheet.Cells(rowCounterW, "H") = wSheet.Cells(rowCounterW, "E") + wSheet.Cells(rowCounterW, "F") + wSheet.Cells(rowCounterW, "G") rowCounterW = rowCounterW + 1 Next c 
Interesting Posts

Защита Windows скрывает некоторые методы из классов .NET?

Код для вставки сформулированного значения в другой столбец в статической форме

Excel: опустить знак минус при форматировании ячейки

Ссылка на массив (внутри массива)

VBA. Как проверить, содержит ли строковая переменная / ячейка другую строку Variable?

Openpyxl max_row и max_column ошибочно сообщают о более крупном размере

Класс PHPExcel не отображает первую строку из базы данных

Как использовать функцию «содержит» в макросе excel

Очистить ячейки, которые являются иждивенцами, и иметь списки проверки

Не могу получить формулу IF (OR (AND) для работы в Excel

Не удалось использовать метод AutoFilter класса Range (Dispatch vs EnsureDispatch)

Как изменить данные Excel Excel в многомерный массив

Как я могу включить несколько условий в выделение ячеек столбца в VBA?

Excel VBA – Loop, необходимый для столбца

Проблема Excel с CountIf только с видимыми ячейками

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