Question

我一直坚持使用“查找”并将其设置为变量。我无法获得所需的结果。在第一张纸上，我有一列Test的值是x或（x）。如果值为x，则需要从EN列复制该值。如果值为（x），请勿复制。

无论x或（x），代码都会从“ EN”列中复制值

我在使用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”列中的所有值都复制到sheet2到column2中。

我只需要EN列中在第1列中具有x值的那些值

Answer 1

您需要重复搜索，直到找到全部。请注意，搜索是循环的，因此您需要记住第一个匹配项。（好消息是它可以是任何单元格，因此您无需从第一个单元格开始搜索。）这是一个用于在整个工作表中搜索特定值的框架：

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

注意：您可以跟踪实际的目标单元，而不是在每个循环中都找到最后一个单元。因此，您在初始化阶段就找到了第一个目标单元（.End(...)...），然后只需在循环内递增行计数器。尽管您会注意到速度仅在数千行上有所提高。

查找并设置为变量，如果

1 个答案: