【求助帖】VBA代码报错invalid procedure call or argument 麻烦大佬们帮忙看一下

[Mr.Cc�]

代码报错invalid procedure call or argument
尝试了各种方法依旧无效

代码如下：

Sub 筛选()
Dim sh As Worksheet, rng As Range, n As Integer, sr As String
Dim arr()
Sheet2.Range("a2:e99999").Clear
sr = InputBox("Input Keyword")
For Each sh In Worksheets
If sh.Name <> "查询" Then
For Each rng In Intersect(sh.UsedRange, sh.[b2:b99999])
If rng.Value Like sr Then
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = rng.Offset(0, -1).Resize(1, 5)
End If
Next
End If
Next sh
Sheet2.Range("a2").Resize(n, 5) = Application.Transpose(Application.Transpose(arr))
End Sub

望各位大佬指点一二
还有一点，这段代码是想从b列把包含关键词的内容抽出来，并把对应的所有列都复制到“查询”工作表中，Like 函数可以实现吗？还有没有更好的实现方法？

小弟在此跪谢大佬们

[humanmagic]

单元格区域不能赋值给一维数组元素
For Each sh In Worksheets
If sh.Name <> "查询" Then
For Each rng In Intersect(sh.UsedRange, sh.[b2:b99999])
If rng.Value Like sr Then
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = rng.Offset(0, -1).Resize(1, 5)
End If
Next
End If
Next sh

[humanmagic]

like支持通配符，如果只是判断相等可以用=

Sub 筛选()
    Dim sh As Worksheet, sr As String
    Dim outArr(), tempArr(), index As Long, i As Long, j As Long
    Sheet2.Range("a2:e99999").Clear
    ReDim outArr(1 To 99998, 1 To 5)
    index = 1
    sr = InputBox("Input Keyword")
    For Each sh In Worksheets
        If sh.Name <> "查询" Then
            tempArr = sh.Range("A2:E" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value
            For i = LBound(tempArr) To UBound(tempArr)
                If tempArr(i, 2) Like sr Then
                    For j = 1 To 5
                        outArr(index, j) = tempArr(i, j)
                    Next j
                    index = index + 1
                End If
            Next i
        End If
    Next sh
    Sheet2.Range("a2:e99999").Value = outArr
End Sub

[Mr.Cc�]

感谢大佬
我重新试了一下，问题似乎出在sr上面
显示n=0

但是如果去掉sr，放弃自定义关键词功能，在代码中直接输入想搜索的内容，就完全没有问题。

结果也可以直接在查询表中显示


搞不懂究竟是为啥...

[humanmagic]

你可以试下2楼代码，你写的具体问题没有文件不好找

[Mr.Cc�]

大佬好
试了一下
发现没有任何反应