vba - 将 "Find(What:="设置为不同 xls 文件中的列

Question

我目前有一个代码可以打开一个空工作簿，然后是一个包含 5000 多行信息的主文件。然后会出现一个弹出窗口并要求提供 ID。我输入我的 6 位 id，宏通过 b 列并复制具有该 id 的行并将其粘贴到空工作簿中。

我的问题是:我必须输入 65 个 ID!我每周都会收到一个包含 65 个 ID 的新工作表。有没有办法设置Find(what:=一些如何在我每周得到的工作表中反射(reflect) id 编号然后循环它:？

这是我的代码:

Sub tester()
' tester Macro

    Workbooks.Open FileName:= _
        "C:\Users\Captain Wypij\Desktop\macrotest\temp.xls"
    Workbooks.Open FileName:= _
        "C:\Users\Captain Wypij\Desktop\macrotest\master.xlsx"

    Application.Run "PERSONAL.xlsb!Tester1"

End Sub

Sub tester1()

Dim res As String
Dim cl As Range
Dim sh As Worksheet
Dim wb As Workbooks

' operate on the active sheet
Set sh = ActiveSheet

res = InputBox("Enter ID to Find", "Copy Row")
 If res = "" Then
    Exit Sub
 End If


With sh
    ' Find first occurance
    Application.FindFormat.Clear
    Set cl = ActiveSheet.Columns.Find(What:=res, _
        After:=.Cells(.Rows.Count, 1), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=True)


        ' if found, select entire row
        Set cl = cl.EntireRow
        ' copy and insert paste data into next row
        cl.Copy

    Windows("temp.xls").Activate

    Sheets("Sheet1").Select
    Range("A9").Select
    If (Range("A9")) > "0" Then Range("A10").Select
    If (Range("A10")) > "0" Then Range("A11").Select
    If (Range("A11")) > "0" Then Range("A12").Select
    If (Range("A12")) > "0" Then Range("A13").Select
    If (Range("A13")) > "0" Then Range("A14").Select
    If (Range("A14")) > "0" Then Range("A15").Select
    If (Range("A15")) > "0" Then Range("A16").Select
    If (Range("A16")) > "0" Then Range("A17").Select
    If (Range("A17")) > "0" Then Range("A18").Select
    If (Range("A18")) > "0" Then Range("A19").Select
    If (Range("A19")) > "0" Then Range("A20").Select
    If (Range("A20")) > "0" Then Range("A21").Select
    If (Range("A21")) > "0" Then Range("A22").Select
    If (Range("A22")) > "0" Then Range("A23").Select
    If (Range("A23")) > "0" Then Range("A24").Select
    If (Range("A24")) > "0" Then Range("A25").Select
    If (Range("A25")) > "0" Then Range("A26").Select
    If (Range("A26")) > "0" Then Range("A27").Select
    If (Range("A27")) > "0" Then Range("A28").Select
    If (Range("A28")) > "0" Then Range("A29").Select
    If (Range("A29")) > "0" Then Range("A30").Select
    If (Range("A30")) > "0" Then Range("A31").Select
    If (Range("A31")) > "0" Then Range("A32").Select
    If (Range("A32")) > "0" Then Range("A33").Select
    If (Range("A33")) > "0" Then Range("A34").Select
    If (Range("A34")) > "0" Then Range("A35").Select
    If (Range("A35")) > "0" Then Range("A36").Select
    If (Range("A36")) > "0" Then Range("A37").Select
    If (Range("A37")) > "0" Then Range("A38").Select
    If (Range("A38")) > "0" Then Range("A39").Select
    If (Range("A39")) > "0" Then Range("A40").Select
    If (Range("A40")) > "0" Then Range("A41").Select
    If (Range("A41")) > "0" Then Range("A42").Select
    If (Range("A42")) > "0" Then Range("A43").Select
    If (Range("A43")) > "0" Then Range("A44").Select
    If (Range("A44")) > "0" Then Range("A45").Select
    If (Range("A45")) > "0" Then Range("A46").Select
    If (Range("A46")) > "0" Then Range("A47").Select
    If (Range("A47")) > "0" Then Range("A48").Select
    If (Range("A48")) > "0" Then Range("A49").Select
    If (Range("A49")) > "0" Then Range("A50").Select
    If (Range("A50")) > "0" Then Range("A51").Select
    If (Range("A51")) > "0" Then Range("A52").Select
    If (Range("A52")) > "0" Then Range("A53").Select
    If (Range("A53")) > "0" Then Range("A54").Select
    If (Range("A54")) > "0" Then Range("A55").Select
    If (Range("A55")) > "0" Then Range("A56").Select
    If (Range("A56")) > "0" Then Range("A57").Select
    If (Range("A57")) > "0" Then Range("A58").Select
    If (Range("A58")) > "0" Then Range("A59").Select
    If (Range("A59")) > "0" Then Range("A60").Select
    If (Range("A60")) > "0" Then Range("A61").Select
    If (Range("A61")) > "0" Then Range("A62").Select
    If (Range("A62")) > "0" Then Range("A63").Select
    If (Range("A63")) > "0" Then Range("A64").Select
    If (Range("A64")) > "0" Then Range("A65").Select
    If (Range("A65")) > "0" Then Range("A66").Select
    If (Range("A66")) > "0" Then Range("A67").Select
    If (Range("A67")) > "0" Then Range("A68").Select
    If (Range("A68")) > "0" Then Range("A69").Select
    If (Range("A69")) > "0" Then Range("A70").Select
    If (Range("A70")) > "0" Then Range("A71").Select
    If (Range("A71")) > "0" Then Range("A72").Select
    If (Range("A72")) > "0" Then Range("A73").Select
    If (Range("A73")) > "0" Then Range("A74").Select
    If (Range("A74")) > "0" Then Range("A75").Select
    If (Range("A75")) > "0" Then Range("A76").Select
    If (Range("A76")) > "0" Then Range("A77").Select
    If (Range("A77")) > "0" Then Range("A78").Select
    If (Range("A78")) > "0" Then Range("A79").Select
    If (Range("A79")) > "0" Then Range("A80").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone _
           , SkipBlanks:=False, Transpose:=False

    Windows("master.xlsx").Activate

    Application.Run "PERSONAL.xlsb!Tester1"

End With

End Sub

Answer 1

' 我会在主数据表后面使用 VBA 代码。然后，您必须寻找您的主 excel，而不是寻找您的 vbs。

' 要添加 taht 代码，请在打开主数据时按 [Alt]-[F11]。

Public Sub ExtractAll()
    Dim Ids2find As Range, Column2search As Range, Cell2find As Range, FoundCell As Range
    Dim ExtractBook As Workbook, ExtractCellA As Range

' 不要提示自己一一输入密码。我而是要求自己从每月获得的工作表中选择带有代码的范围

    Set Ids2find = Application.InputBox(Prompt:="Please select the IDs to extract from the master", Title:="Range Select", Type:=8)

    If Not Ids2find Is Nothing Then

' 我们不会在完整表中查找代码，只在带有键的列中查找

        Set Column2search = Me.Columns(2)

' 创建目标工作簿

        Set ExtractBook = Workbooks.Add
        Set ExtractCellA = ExtractBook.Sheets(1).Cells(1, 1)

' 为什么不复制标题呢？

        Column2search.Rows(1).Copy
        ExtractCellA.PasteSpecial

' 并在目的地前进一个单元格

        Set ExtractCellA = ExtractCellA.Offset(RowOffset:=1)

' 现在遍历选定的单元格

        For Each Cell2find In Ids2find

' 找到你要找的东西

            Application.FindFormat.Clear
            Set FoundCell = Column2search.Find(What:=Cell2find.Value, _
                After:=.Cells(.Rows.Count, 1), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=True)

' 复制并再次前进

            FoundCell.EntireRow.Copy
            ExtractCellA.PasteSpecial
            Set ExtractCellA = ExtractCellA.Offset(RowOffset:=1)
        Next Cell2find

' 您可以在此处添加代码以保存您的工作簿，但我会手动保存

    End If
End Sub

' 你需要一种方法来启动它。例如，您可以在主工作表上插入“表单控件”按钮。可能您必须首先启用您的开发人员选项卡。我让你用谷歌搜索。