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

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

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

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

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

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

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

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

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

|источник

1 ответ1

1

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


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

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

Вот пересмотр кода относительно вашего последнего комментария.

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. Добавление третьего счетчика для размещения данных на новом листе для скопированных данных на Лист2. И, наконец, вложенный цикл (цикл внутри цикла). Loop-Outer: просматривает мастер-список (xSheet) построчно; никогда не повторяется Loop-Inner: просматривает таблицу данных для сравнения сверху вниз; повторяет каждую новую строку в Master List.


Вы могли бы даже изменить оператор 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
|источник

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .