Question

我已经找了很多宏/代码来帮助我做到这一点，虽然我已经找到了几个提示，但我找不到解决方案。也许这是我对vba的经验不足或者这是一个独特的情况，我无法自定义这些代码为我工作。正如你可以从我提出的其他问题中看到的那样，我总是尝试在发布之前尝试解决方案，但这是我真正努力的情况，并希望它是一个简单的，你可以帮助我。 / p>

我的工作表： Book1.xls ，有一个包含1000个数字的列表
在工作表中： Sheets1 ，在A栏中，我希望通过循环浏览10个文件夹中的大约1,000个文件来查找每个数字

“DirectoryA \ A”，
  “DirectoryA \ B”，
  “DirectoryA \ C”，
  “DirectoryA \ d”，
  “DirectoryA \ E”，
  “DirectoryA \ F”，
  “DirectoryA \ G”，
  “DirectoryA \ H”，
  “DirectoryA \ I”，
  “DirectoryA \ J”

每当我找到该号码时，我想将该单元格的内容返回到该号码的右侧，并将其打印到Book1.xls中相应值的右侧。

一如既往地谢谢。

Answer 1

这是一个选项

应放在包含Sheets
查看指定文件夹中所有文件的第一列，搜索A列中的每个数字
从搜索文件的B列返回任何找到的数字
这些附加在原始数字
将变量数组转储到当前工作簿中的新工作表，然后使用TexttoColumns

如果你想要它可以在你的10个文件夹中多次指向，或者更新以循环遍历DirectoryA的子文件夹

码

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

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

1 个答案: