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

问题描述

希望在工作簿 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

复制 SUB FOR @ValonMiller 9.26.18 响应下面评论中的请求

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

标签： excelvba

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

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

问题描述

解决方案

推荐阅读