Excel vba: копировать строки, если данные соответствуют значениям в столбце на другом листе

Я задал здесь связанный с этим вопрос.
Сэр Аделаида предоставила мне это очень полезное решение.

Итак, теперь, в этом почти подобном случае, у меня есть 2 листа excel в моей книге.
[Xsheet] [1] Sheet1

Я прохожу через столбец имени и описания в Sheet1, чтобы увидеть, соответствует ли оно значению в столбце name или description в XSheet (в столбце могут быть бесконечные строки данных). Если они это сделают, то «эта» строка в Sheet1 будет скопирована в новый лист2.

Я немного изменил предыдущее кодирование (предоставлено сэром Аделаидой),

Sub Procedure2() Dim xsht As Worksheet Dim sht As Worksheet 'original sheet Dim newsht As Worksheet 'sheet with new data Set xsht = ThisWorkbook.Worksheets("Xsheet") Set sht = ThisWorkbook.Worksheets("Sheet1") Set newsht = ThisWorkbook.Worksheets("Sheet2") 'Set dat = sht.Range("code").Cells(1,1) Set main = xsht.Range("A1") Set dat = sht.Range("A1") Set newdat = newsht.Range("A1") 'initialise counters i = 1 j = 1 'set heading on sheet2 newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status Do While dat.Offset(i, 0).Value <> "" 'loop row till code data goes blank If ((main.Offset(i, 0).Value = dat.Offset(i, 4).Value Or _ main.Offset(i, 1).Value = dat.Offset(i, 5).Value) And dat.Offset(i, 6).Value = "active") Then 'check conditions newdat.Offset(j, 0).Value = dat.Offset(i, 0).Value 'copy code newdat.Offset(j, 1).Value = dat.Offset(i, 2).Value 'copy title newdat.Offset(j, 2).Value = dat.Offset(i, 3).Value 'copy date newdat.Offset(j, 3).Value = dat.Offset(i, 4).Value 'copy name newdat.Offset(j, 4).Value = dat.Offset(i, 5).Value 'copy descr newdat.Offset(j, 5).Value = dat.Offset(i, 6).Value 'copy status j = j + 1 End If i = i + 1 Loop 

Любые предоставленные рекомендации будут оценены по достоинству. Спасибо.
Output Привет, я пытался запустить обновленный код.
Это мой вывод, но есть неактивный случай, что неверно.
Правильный вывод должен быть 4566,4987,4988.
Я прошел через код, Idk, что пошло не так

Я убираю ссылку Xsheet, потому что у меня нет достаточной репутации, чтобы сделать более 2 гиперссылок

Теперь я просматриваю Sheet1, чтобы увидеть, соответствуют ли его столбцам в Xsheet.
4566, он соответствует «Адам» в имени col (так как это имя или описание, поэтому, если имя совпадает, то это совпадение) и (необходимо быть) активным, поэтому его вход.
4899, Эдвард – это матч (или какое-либо описание), но не соответствует и не активен, поэтому нет.
4987, тот же случай, что и 4566, его Адам и активный.
4988, Крис (не имя матча), но al находится в описании Xsheet и активен, так что он находится.
4989, Chris не имя матча, ttr не описание матча, даже его активный случай (я тоже не возьму его)

Спасибо за ваше руководство. Я очень ценю это.

Итак, узнав, что вы на самом деле делаете. Вопрос прост:

«Если имя или описание в главном списке найдено в Листе данных и оно также активно, а затем скопируйте его на новый лист».

Логические операторы: порядок приоритета

Ниже приведена редакция кода по вашему недавнему комментарию.

 Sub Procedure2() Dim xsht As Worksheet Dim sht As Worksheet 'original sheet Dim newsht As Worksheet 'sheet with new data Set xsht = ThisWorkbook.Worksheets("Xsheet") Set sht = ThisWorkbook.Worksheets("Sheet1") Set newsht = ThisWorkbook.Worksheets("Sheet2") 'Set dat = sht.Range("code").Cells(1,1) Set main = xsht.Range("A1") Set dat = sht.Range("A1") Set newdat = newsht.Range("A1") 'initialise counters Dim i, j, iRow As Integer 'instantiate and initialize the integers i = 1 j = 1 iRow = 1 'set heading on sheet2 newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status Do While main.Offset(i, 0).Value <> "" Or main.Offset(i, 1).Value <> "" j = 1 'reset DataSheet pointer Do While dat.Offset(j, 0).Value <> "" If (main.Offset(i, 0).Value = dat.Offset(j, 4).Value _ Or main.Offset(i, 1).Value = dat.Offset(j, 5).Value) _ And dat.Offset(j, 6).Value = "active" Then newdat.Offset(iRow, 0).Value = dat.Offset(j, 0).Value 'copy code newdat.Offset(iRow, 1).Value = dat.Offset(j, 2).Value 'copy title newdat.Offset(iRow, 2).Value = dat.Offset(j, 3).Value 'copy date newdat.Offset(iRow, 3).Value = dat.Offset(j, 4).Value 'copy name newdat.Offset(iRow, 4).Value = dat.Offset(j, 5).Value 'copy descr newdat.Offset(iRow, 5).Value = dat.Offset(j, 6).Value 'copy status iRow = iRow + 1 End If j = j + 1 'increment DataSheet pointer; fast moving; changing/resetting Loop i = i + 1 'increment XSheet pointer; slow moving outer loop; not resetting Loop End Sub 

В этом обновленном коде есть ЧЕТЫРЕ изменения . Добавлена ​​проверка в OUTER Loop, чтобы включить пробелы в поле Name, добавив Or main.Offset(i, 1).Value <> "" . Изменение того, где информация оценивалась от i-to-i_value до i-to-j_value, в инструкции If . Добавление третьего счетчика для размещения данных в новом листе для скопированных данных в Sheet2. И, наконец, вложенный цикл (цикл внутри цикла). Loop-Outer: просмотр строкового списка (xSheet) по строкам; Никогда не повторяется. Loop-Inner: обращается к спецификации для сравнения сверху вниз; Повторяет каждую новую строку в главном списке.

Вы могли бы даже изменить оператор If, чтобы считать «активным» или «активным», или «A» или «a». Вот где список подсказок пригодится, но это еще одна проблема сама по себе.

 If (main.Offset(i, 0).Value = dat.Offset(j, 4).Value _ Or main.Offset(i, 1).Value = dat.Offset(j, 5).Value) _ And (dat.Offset(j, 6).Value = "active" Or dat.Offset(j, 6).Value = "Active") Then 
  • VBA для вставки встроенного изображения excel
  • Повторение случайных величин в VBA
  • Основы того, как заставить процедуру VBA работать в excel при изменении ячейки
  • Отправка форматированного текстового сообщения Lotus Notes из Excel VBA
  • Выполнить панель состояния Excel?
  • Как получить путь к текущему рабочему листу в VBA?
  • Создайте новый лист для каждого уникального агента и переместите все данные на каждый лист
  • Могу ли я запустить этот макрос быстрее?
  • Каков наиболее эффективный / быстрый способ циклического преобразования строк в VBA (excel)?
  • Создание документов Word (в Excel VBA) из серии шаблонов документов
  • автоматически выполнять макрос Excel при смене ячейки
  • Давайте будем гением компьютера.