VBA Выберите данные в таблице, которые соответствуют критериям - PullRequest
Новая
       50

VBA Выберите данные в таблице, которые соответствуют критериям

0 голосов
/ 27 марта 2020

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

Option 1

Dim Cell As Range
Dim EML As Range
For Each Cell In Worksheets("Project Directory").Range("Directory[OAC]")
For Each EML In Worksheets("Project Directory").Range("Directory[EMAIL]")
If Cell = "Y" Then
Worksheets("Data").Range("A1") = Worksheets("Project Directory").EML
End If

Next Cell

Option 2

If Worksheets("Sheet1").ListObjects("Table1").ListColumns(8).DataBodyRange = "Y" Then
Worksheets("Sheet2").Range("A1") = Worksheets("Sheet1").ListObjects("Table1").ListColumns(5)
End If

1 Ответ

0 голосов
/ 30 марта 2020

вам кажется, что в вашем коде пропущены биты: в первом l oop не закрыт. Во втором варианте у вас нет al oop. В обоих случаях все результаты будут записаны и переписаны в Sheet2, ячейка A1. Если я адаптирую ваш код для этих пропусков, это два примера, которые должны работать (не проверено). Приветствия Вариант 1 

Dim Cell As Range
Dim EML As Range
r = 1
For Each Cell In Worksheets("Project Directory").Range("Directory[OAC]")
  For Each EML In Worksheets("Project Directory").Range("Directory[EMAIL]")
    If Cell = "Y" Then
      Worksheets("Data").Range("A" & r).Value = Worksheets("Project Directory").EML
      r = r + 1
    End If
  Next EML
Next Cell

Вариант 2 

Dim Tbl As ListObject
Set Tbl = Worksheets("Sheet1").ListObjects("Table1")
r = 1
For Each DataRw In Tbl.ListRows
    If DataRw.ListColumns(8).DataBodyRange = "Y" Then
        Worksheets("Sheet2").Range("A1").Offset(r, 0) = Tbl.ListColumns(5).Value
        r = r + 1
    End If
Next
...