найти и установить в качестве переменной, и если - PullRequest
Новая
       15

найти и установить в качестве переменной, и если

1 голос
/ 04 мая 2019

Я застрял с использованием Find и установить в качестве переменной.Я не могу получить результат, который мне нужен.На первом листе у меня есть столбец Test со значениями x или (x).Если значение равно x, мне нужно скопировать значение из столбца EN.Если значение (x), не копировать.

код копирует значения из столбца "EN" независимо от x или (x)

Возможно, у меня возникла ошибка при использовании Set stfound 

Dim ENcolumn
Dim xcolumn
Dim secrow
Dim lastrow
Dim totrow

Worksheets("List1").Activate
Worksheets("List1").Range("A1:C1").Find(What:="EN", MatchCase:=True, 
lookAT:=xlWhole).Activate
ENcolumn = ActiveCell.Column 'find and create variable

Worksheets("List1").Range("A1:C1").Find(What:="test", MatchCase:=True, 
lookAT:=xlWhole).Activate
xcolumn = ActiveCell.Column 'find and create variable

currow = ActiveCell.Row + 1 ''make one low rower than current row (first 
value)
lastrow = Worksheets("List1").Cells(Rows.Count, xcolumn).End(xlUp).Row
For totrow = currow To lastrow

Set stfound = Cells.Find(What:="x", After:=Cells(totrow, xcolumn), 
MatchCase:=True, lookAT:=xlWhole)

If Not stfound Is Nothing Then 'if value is found then do this

Worksheets("List1").Cells(totrow, ENcolumn).Copy 'copy values
Worksheets("List2").Activate
b = Worksheets("list2").Cells(Rows.Count, ENcolumn).End(xlUp).Row
Worksheets("list2").Cells(b + 1, 2).Select 'select first empty cell in 
second column
ActiveSheet.Paste

ActiveCell.Offset(0, 1).Value = "receivercode"
ActiveCell.Offset(0, 2).Value = "01.01.2019"
Worksheets("list1").Activate

End If
Next

Application.CutCopyMode = False 'stop if false
ThisWorkbook.Worksheets("List1").Cells(1, 1).Select
MsgBox ("done")`

Теперь я получаю все значения из столбца "EN", скопированные в лист2 в столбец 2.

Мне нужны только те значения в столбце EN, который имеет значение x в столбце 1

1 Ответ

0 голосов
/ 06 мая 2019

Вам нужно повторять поиск, пока не найдете все.Обратите внимание, что поиск является круговым, поэтому вам нужно запомнить первое совпадение.(Хорошая новость заключается в том, что это может быть любая ячейка, поэтому вам не нужно начинать поиск с самой первой ячейки.) Вот кадр для поиска во всем листе определенного значения: 

Dim s1st As String
Dim rFnd as Range

Set rFnd = Nothing
With ActiveSheet.UsedRange
     Set rFnd = .Cells.Find(What:="x", LookIn:=xlValues, lookat:=xlWhole, _ 
                             SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=True)
     If Not rFnd Is Nothing Then
       s1st = rFnd.Address
       Do
                ' do here what you need to do with your found cell. 
                ' rFnd points to the found cell with the value "x"
                ' e.g. 
           rFnd.Copy    ' single cell
           b = Worksheets("list2").Cells(Rows.Count, ENcolumn).End(xlUp).Row
           Worksheets("list2").Paste Destination:=Worksheets("list2").Cells(b + 1, 2)
           Set rFnd = .FindNext(rFnd)
       Loop While Not rFnd Is Nothing And rFnd.Address <> s1st
    End If
End With

NB: вы можете отслеживать фактическую ячейку назначения вместо того, чтобы находить последнюю в каждом цикле.Таким образом, вы находите первую ячейку назначения (.End(...)...) один раз на этапе инициализации, а затем просто увеличиваете счетчик строк в цикле.Хотя вы заметите любое увеличение скорости только за тысячи строк.

...