Блог

Я пытаюсь найти способ автоматизировать пользовательские фильтры, которые создаются для повседневных операций. По-настоящему изучать VBA я начал всего 24 часа назад, поэтому использовал комбинацию записи макросов, а также сочетание различных решений, которые я нашел в Интернете. Приведенный ниже код наиболее близок к тому, что мне было нужно, но есть некоторые странности, обстоятельства возникновения которых я не совсем понимаю, не говоря уже о том, чтобы каким-либо образом их исправить.

Я попытался компенсировать строки вместе с добавлением или удалением одной снизу с минимальным успехом, поскольку в ней всегда указывается, что ее часть недопустима (я предполагаю, потому что ее нужно где-то определить, но не совсем уверен, в каком формате). Что, казалось, работало лучше всего, так это комбинация обработки ошибок и специальных ячеек, где скрипт должен игнорировать добавляющую значение часть, если во 2-й строке ничего не заполнено. Если там что-то заполнено, то будет добавлено значение в последний столбец, но только для пустых ячеек.

 Columns("A:H").Select

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$H$800000").AutoFilter Field:=2, Criteria1:="=*",
_Operator:=xlAnd

    ActiveSheet.Range("$A$1:$H$800000").AutoFilter Field:=8,
Criteria1:="=*In*", _Operator:=xlAnd
  

Предполагается, что это отфильтровывает то, что мне нужно для каждой вкладки в Excel. Я ищу
для любых документов, которые имеют значение во 2-м столбце (B), и любых документов
которые содержат «In» в 8-м столбце (H). Создаваемые отчеты могут сильно различаться
по длине я определил 800k как хороший порог.

 On Error GoTo NoBlanks01
If Range("$A$2:$H$2").SpecialCells(xlCellTypeVisible).Count > 0 Then
Columns("I:I").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "InsertValueHere"

Skip01:
On Error Resume NextEnd If
  

Я не уверен на 100%, что использование их таким образом является избыточным, но мое мышление здесь
было ли это, если во второй строке что-то есть, продолжайте. В противном случае ошибка приведет
будет создан и будет следовать до конца скрипта, затем перейдите к skip01 и
действуйте оттуда. По сути, минуя значение, добавляющее там, где оно будет
выделите все пустые ячейки в строке I и добавьте «Вставить значение здесь». Эта часть
в целом работает, но в Excel есть несколько вкладок, где будут элементы
во второй строке, однако скрипт не распознает их и переходит через
обработка ошибок. Это та часть, которую я не понимаю.

 NoBlanks01:
Resume Skip01
  

«У меня есть 11 «пробелов», «Без пропусков» и «Возобновлений» в одном подразделе. Все в соответствии
на разные вкладки. Опять же, не уверен, имеет ли это значение, но решил заявить, что
на случай, если есть какой-то порядок операций, который я пропустил при изучении этого.

Я ожидаю, что скрипт должен выполнить фильтрацию в соответствии с указанными спецификациями, затем выполнить запрос, в котором он проверяет, содержит ли вторая строка какие-либо элементы. Если это так: тогда следует перейти к выбору последнего столбца на этой вкладке, выбрать только пустые ячейки на этой вкладке, затем закодировать для них значение. Если это не так: тогда следует пропустить добавление любого значения и перейти прямо к соответствующим «пробелам», за которыми следует соответствующее «Пропустить».

В нынешнем виде это завершает логику на некоторых вкладках, но не на других. Я понятия не имею, почему, когда вторая строка явно заполнена. Я понимаю, что наличие некоторых из этих отчетов пригодилось бы, поэтому при необходимости я могу их предоставить.

Попробуйте что-то вроде этого:

 Dim sht As Worksheet, rng As Range, rngVis As Range

Set sht = ActiveSheet

Set rng = sht.Range("a1").CurrentRegion      '<< the range with data and headers
If Application.CountA(rng) = 0 Then Exit Sub '<< exit if have no data...

rng.AutoFilter

rng.AutoFilter field:=2, Criteria1:="=*"
rng.AutoFilter field:=8, Criteria1:="=*In*"

'Next line should not throw an error even if all data
'  rows are filtered, since there's always the header row visible
Set rngVis = rng.Columns("I").SpecialCells(xlCellTypeVisible)

If rngVis.Count > 1 Then '<< ignore if only the header row...
    rngVis.SpecialCells(xlCellTypeBlanks).Value = "InsertValueHere"
End If