Excel 在1000个工作簿中搜索1000个数字

我一直在寻找一个宏/代码来帮助我做到这一点，虽然我找到了一些关于它的提示，但我找不到解决方案。也许是因为我对vba缺乏经验，或者是因为这是一个独特的情况，我无法定制这些代码来为我工作。从我问的其他问题中你可以看到，我总是试图在发布之前尝试一个解决方案，但这是我一直在努力解决的问题，希望你能帮助我解决这个问题

• 我的工作表：Book1.xls，有1000个数字的列表
• 在sheet:Sheets1的A列中，我想通过循环10个文件夹中的大约1000个文件来查找每个数字

“目录A\A”，
“目录A\B”，
“目录a\C”，
“目录a\D”，
“DirectoryA\E”，
“目录a\F”，
“目录a\G”，
“目录a\H”，
“DirectoryA\I”，
“目录a\J”

• 每次我找到数字时，我都希望将单元格的内容返回到数字的右侧，并将其打印到Book1.xls中相应值的右侧

---

一如既往地感谢您。

这里有一个选项

• 应放在包含

  工作表

  A列数字的工作簿中
• 它查看指定文件夹中所有文件的前几列，搜索a列中的每个数字
• 找到的任何数字都将从搜索文件的B列返回
• 它们被附加在原始数字的变体数组中
• 变量数组转储到当前工作簿中的新工作表中，然后使用

  TexttoColumns

如果需要，您可以将其多次指向10个文件夹，或更新以循环浏览DirectoryA的子文件夹

代码

---

原始工作表中的每个数字在1000个文件中总共只出现一次，还是会出现多次？如果是多个，您需要所有事件还是仅一个？可能有多个事件-因此我需要所有事件！嗨@brettdj，这几乎就是我要找的。我唯一的问题是我想搜索整个工作簿，而不仅仅是第一列。我尝试将：Set rng2=Wb2.Sheets（1）.Columns（1）.Find（X（lngCnt，1），xlValues，xlWhole）更改为：Set rng2=Wb2.Cells.Find（X（lngCnt，1），xlValues，xlWhole）-但这将返回“对象不支持此属性或方法”错误。你能帮我调整这个部分，让它搜索整个工作簿吗？谢谢每张工作表A列中的所有单元格，或每张工作表中的所有单元格？为了澄清，我想搜索每张工作簿中每张工作表中的所有单元格。再次感谢。

Sub LoopThroughFiles()
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim ws As Worksheet
Dim StrFile As String
Dim strDelim As String
Dim rng1 As Range
Dim rng2 As Range
Dim X
Dim Y
Dim lngCalc As Long
Dim lngCnt As Long

Set Wb = ThisWorkbook
Set ws = Wb.Sheets("Sheets1")
Set rng1 = ws.Range(ws.[a1], ws.Cells(Rows.Count, "A").End(xlUp))

If rng1 Is Nothing Then Exit Sub
X = rng1.Value2
Y = X
strDelim = ";"

With Application
.EnableEvents = False
.ScreenUpdating = False
lngCalc = .Calculation
.Calculation = xlManual
End With

StrFile = Dir("c:\temp\*.xls*")
Do While Len(StrFile) > 0
Set Wb2 = Workbooks.Open("c:\temp\" & StrFile)
For lngCnt = 1 To UBound(X)
    If Len(lngCnt) > 0 Then
        If IsNumeric(lngCnt) Then
            Set rng2 = Wb2.Sheets(1).Columns(1).Find(X(lngCnt, 1), , xlValues, xlWhole)
             If Not rng2 Is Nothing Then
                Y(lngCnt, 1) = Y(lngCnt, 1) & ";" & rng2.Offset(0, 1)
             End If
        End If
    End If
Next
    StrFile = Dir
    Wb2.Close False
Loop

Set ws = Wb.Sheets.Add
ws.[a1].Resize(UBound(X), 1).Value2 = Y
ws.Columns(1).TextToColumns ws.[a1], xlDelimited, , True, Other:=True

With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = lngCalc
End With

End Sub