我有一些vba代码来打开基于filename-date的excel文件(即“test-09Sep2016.xlsm” .
打开文件后,它会搜索工作簿并尝试查找我正在查找的内容 . 一旦它返回结果,它将关闭工作簿并循环遍历文件夹以查找下一个文件等等....
问题是文件大小很大,打开文件需要很长时间,我想知道是否有办法在不打开实际文件的情况下这样做 .
我目前的代码如下:
Sub firstCoord()
Dim fpath As String, fname As String
Dim dateCount As Integer, strDate As Date
Dim i As Integer, j As Integer, k As Integer, lastRow As Integer, lastRow2 As Integer
Dim ws As Worksheet, allws As Worksheet
Dim seg As String
Dim strNum As String
Dim strRow As Integer
lastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
seg = Mid(ThisWorkbook.Name, 34, 1)
With Application.WorksheetFunction
For i = 2 To lastRow
fpath = "_______\"
strDate = Sheet1.Range("B" & i)
strNum = seg & Format(Mid(Sheet1.Range("A" & i), 4, 3), "000") & "000"
dateCount = 0
Do While Len(Dir(fpath & "_____-" & Format(strDate - dateCount, "ddmmmyyyy") & ".xlsx")) = 0 And dateCount < 35
dateCount = dateCount + 1
Loop
fname = "____-" & Format(strDate - dateCount, "ddmmmyyyy") & ".xlsx"
Workbooks.Open (fpath & fname)
For Each ws In Workbooks(fname).Worksheets
If ws.Name Like "*all*" Then
Set allws = Workbooks(fname).Worksheets(ws.Name)
ws.Activate
End If
Next ws
lastRow2 = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
ThisWorkbook.Activate
k = 1
Do While (.CountIf(Sheet1.Range("C" & i & ":" & "E" & i), "") <> 0 Or Sheet1.Range("F" & i) = "") And k <= lastRow2
If Left(allws.Range("A" & k), 7) = strNum Then
Sheet1.Range("C" & i) = allws.Range("D" & k)
Sheet1.Range("D" & i) = allws.Range("C" & k)
Sheet1.Range("E" & i) = allws.Range("E" & k)
ElseIf k = lastRow2 And Sheet1.Range("C" & i) = "" Then
Sheet1.Range("F" & i) = "Not Found"
End If
k = k + 1
Loop
Workbooks(fname).Close
Next i
End With
End Sub
任何帮助将不胜感激!!
谢谢