|
|
楼主 |
发表于 2012-2-1 13:28
|
显示全部楼层
查找了一下以前的帖子，有不少帮助的信息，因为对VBA懂的不多，我拼凑了一些论坛上程序，在此向各位老师表示感谢！但是程序还没有实现自己的目的，在执行到“StrStatus = Rng.Offset(-5, 0).Value”这一句时提示错误“1004---Application-defined or object-defined error”。恳请各位老师能不吝赐教。非常感谢！
我想实现的方法是：在指定的目录（包括子目录）下中文件名包含"mm"的文件里查找当前文件F列的字符，如找到则将找到的字符所在的工作表中相应的A，D列中的信息填入到当前文件的A，D列，当前的文件的B列值设为N。
Sub cztq()
Dim MyName, Dic, Did, I, J, Jrow, MyFileName
Dim Wb As Workbook, Ws As Worksheet, Rng As Range, StrStatus$, StrNew$, StrType$, Arr, N&, Findstr$, Sht1 As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Dic.Add ("D:\"), ""
I = 0
Do While I < Dic.Count
Ke = Dic.keys
MyName = Dir(Ke(I), vbDirectory)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then
Dic.Add (Ke(I) & MyName & "\"), ""
End If
End If
MyName = Dir
Loop
I = I + 1
Loop
Set Sht1 = ActiveSheet
Jrow = Sht1.[F65536].End(xlUp).Row
For J = 2 To Jrow
Findstr = Cells(J, 6).Value
For Each Ke In Dic.keys
MyFileName = Dir(Ke & "*mm*.xls")
Do While MyFileName <> "" And MyFileName <> ThisWorkbook.Name
Set Wb = GetObject(Ke & MyFileName)
With Wb
For Each Ws In .Worksheets
With Ws
If WorksheetFunction.CountIf(.UsedRange, Findstr) <> 0 Then
Set Rng = .UsedRange.Find(Findstr)
StrStatus = Rng.Offset(-5, 0).Value
StrNew = "N"
StrType = Rng.Offset(-2, 0).Value
Do
With Sht1
.Cells(J, 1) = StrStatus
.Cells(J, 2) = StrNew
.Cells(J, 4) = StrType
End With
Loop While .UsedRange.Find(Findstr).Address <> Rng.Address
End If
End With
Next Ws
End With
Wb.Close False
MyFileName = Dir
Loop
Next
Next
Application.ScreenUpdating = True
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-1-19 10:03
发表于 2012-1-19 11:48
