请教怎么修改

38180203

1.怎么修改被查找的是B列(现在是E列)
2.怎么修改查找到的结果放到B3(现在是G2)
谢谢你


Sub FindData()
    Dim Str$
    Dim rng As Range
    Dim Sh As Worksheet

    Rows("2:65536").Delete
    Str = "*" & [F1] & "*"
    Application.ScreenUpdating = False
    For Each Sh In Sheets
        If Sh.Name <> ActiveSheet.Name Then
            For Each rng In Sh.Range("E2", Sh.[E65536].End(3))   '这段代码搞不懂
                If rng Like Str Then rng.Offset(, -3).Resize(1, 19).Copy [G65536].End(3)(2)   '这段代码搞不懂
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub

petergaod

Sub FindData()
    Dim Str$
    Dim rng As Range
    Dim Sh As Worksheet

    Rows("3:65536").Delete
    Str = "*" & [F1] & "*"
    Application.ScreenUpdating = False
    For Each Sh In Sheets
        If Sh.Name <> ActiveSheet.Name Then
            For Each rng In Sh.Range("B2", Sh.[B65536].End(3))
                If rng Like Str Then rng.Offset(, -1).Resize(1, 19).Copy [B65536].End(3)(2)
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub

38180203

petergaod 发表于 2019-9-6 21:30
Sub FindData()
    Dim Str$
    Dim rng As Range

不行,这样改搜索出来的结果只显示1条

moonlit123

Sub FindData()
    Dim Str$
    Dim rng As Range
    Dim Sh As Worksheet

    Rows("3:65536").Delete
    Str = "*" & [F1] & "*"
    Application.ScreenUpdating = False
    For Each Sh In Sheets
        If Sh.Name <> ActiveSheet.Name Then
            For Each rng In Sh.Range("B2", Sh.[B65536].End(3))
                If rng Like Str Then
                Sh.Rows(rng.Row).Copy [B65536].End(3)(2).Offset(0, -1)
                End If
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub