Question

我目前正在尝试在excel电子表格中查找某个单词，复制右侧的单元格，然后再将其粘贴到右侧的3个单元格和3个向下的单元格中，然后将其向下拖动。

我已经完成了下面的工作。

Cells.Find(What:="N/C:", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
    Selection.Offset(0, 1).Select
Selection.Copy

Selection.Offset(3, 3).Select
ActiveSheet.Paste

Range(Selection, Selection.End(xlDown)).Select

Selection.FillDown

我的问题是： 如何扩展此代码，使其搜索所有“ N / C：”并执行以上操作

如果可以改进，请随时为我的初始代码提供更新

Answer 1

简短的答案是，没有内置的方法可以一次性返回包含所有查找结果（即全部查找）的范围。您必须找到第一个结果（您已经拥有的代码），然后在while循环中使用findNext，仅当下一个结果与第一个结果引用相同的单元格时才退出。

http://www.cpearson.com/excel/findall.aspx

有一个很好的解释/实现。

Answer 2

经过轻松测试：

Sub Tester()

    Dim col As Collection, c, sht As Worksheet

    Set sht = ActiveSheet

    Set col = FindAll(sht.UsedRange, "N/C:")
    Debug.Print "Found " & col.Count & " matches"

    For Each c In col
        c.Copy c.Offset(3, 3)
        sht.Range(c.Offset(3, 3), c.Offset(3, 3).End(xlDown)).FillDown
    Next c


End Sub


Public Function FindAll(rng As Range, val As String) As Collection
    Dim rv As New Collection, f As Range
    Dim addr As String

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)

    If Not f Is Nothing Then addr = f.Address()

    Do Until f Is Nothing
        rv.Add f
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop

    Set FindAll = rv
End Function

VBA-Excel CTRL查找

2 个答案: