Excel VBA - 运行驻留在工作簿 A 中的宏以影响工作簿 B。B 的名称是通配符

Question

希望在工作簿 B 中使用过滤器，其中包含工作簿 A 中的剪贴板内容。工作簿 B 名称是通配符，需要从工作簿 A 运行宏。到目前为止，我有：

Sub SwitchAndFilter()
'

Dim wb As Workbook

For Each wb In Application.Workbooks
   If wb.Name Like "*ABC_*" Then wb.Activate:
   With ActiveWorkbook
'code here just getting run onto workbook A, plus don't know how to pass clipboard contents to a filter
ActiveSheet.Range("$A$1:$W$501").AutoFilter Field:=3, Criteria1:="12345" ' this should be clipboard contents from Workbook A
   End With
    Exit Sub
Next wb

'if code gets here, it isn't already open...
End Sub

更新 1 在线获取“运行时错误 '9'：下标超出范围”：

.Sheets("Sheet1").Range("AA1").Paste

根据下面的建议“应该从范围中获取过滤条件，而不是剪贴板”，我尝试首先将剪贴板粘贴到 wbB 上的范围中，然后参考该范围进行过滤。我现在拥有的完整代码是：

Sub SwitchAndFilter3()
    Dim wbA As ThisWorkbook
    Dim wbB As Workbook

    Set wbA = ThisWorkbook

    For Each wbB In Application.Workbooks
        If wbB.Name Like "*ABC_*" And wbA.Name <> wbB.Name Then

            'Your with should reference the context of your for, i.e. wbB, not ActiveWorkbook.
            With wbB

                'You should really try to avoid Activesheet
                'Also, you should get the filter criteria from the range, not the clipboard.
                '
                .Sheets("Sheet1").Range("AA1").Paste
                .ScrollColumn = 2
                '
                .Sheets("Sheet1").Range("$A$1:$W$501").AutoFilter Field:=3, Criteria1:=wbB.Sheets("Sheet1").Range("AA1").Value

                'If you need wbB to be active:
                .Activate

            End With

            Exit Sub
        End If
    Next wbB

COPY SUB FOR @ValonMiller 18 年 9 月 26 日响应以下评论中的请求

Sub CopyFirstOne()
Dim position As Integer
Dim substring As String
position = InStr(ActiveCell, " ")
If (position > 0) Then
    substring = Left(ActiveCell, position - 1)

    Dim MyText As DataObject
    Set MyText = New DataObject

    On Error Resume Next
    MyText.setText substring
    MyText.PutInClipboard

End If
'below macro works on it's own, but Calling from here crashes XL for a bit and gives error on PasteSpecial
'Call SwitchAndFilterWorks
End Sub

10.8.18 更新

Sub ListFiles_A3_Works()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

    Application.Goto Reference:="Body"
    Selection.ClearContents

    Range("B6").Select

objFolderName = Range("A3").Value

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(objFolderName)
'Set objFolder = objFSO.GetFolder(Range("A3").Value)
i = 5
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.Name
'print file path
'Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
    Range("B6").Select
    Range("A6").Select
        ActiveWindow.ScrollRow = Selection.Row
Call CopyFirstOne
End Sub

Answer 1

[根据上述讨论于 9 月 26 日更新]

确保使用正确的工作表名称更新With wbB.Sheets("Sheet1") 行。

Sub CopyFirstOne()
    Dim position As Integer
    Dim substring As String

    position = InStr(ActiveCell, " ")

    If (position > 0) Then
        substring = Left(ActiveCell, position - 1)
    Else
        substring = ActiveCell.Value
    End If

    'Pass the filter string directly
    Call SwitchAndFilter(substring)
End Sub

Sub SwitchAndFilter(fitlerValue As String)
    Dim wb As Workbook

    For Each wb In Application.Workbooks
        If wb.Name Like "*ABC_*" And ThisWorkbook.Name <> wb.Name Then

            'Changed with to target Sheet, instead of Workbook
            With wb.Sheets("Sheet1")

                .Range("$A$1:$W$501").AutoFilter Field:=3, Criteria1:=fitlerValue

                'Optional
                .Activate

            End With

            Exit Sub
        End If
    Next wb

    'if code gets here, it isn't already open...

End Sub

Answer 2

我认为这不是最好的解决方案，但要解决我认为是您的复制/粘贴问题的根本原因，请尝试以下操作：

Sub CopyFirstOne()
    Dim position As Integer
    Dim substring As String
    Dim MyText As DataObject

    Set MyText = New DataObject

    position = InStr(ActiveCell, " ")

    If (position > 0) Then
        substring = Left(ActiveCell, position - 1)
    Else
        substring = ActiveCell.Value
    End If

    On Error Resume Next
    MyText.setText substring
    MyText.PutInClipboard

    Call SwitchAndFilterWorks
End Sub