文件夹中多工作薄指定工作表中提取指定字符的数据
【问题描述】一个文件夹中有4年的公司的销售情况的Excel文件，一个月一个文件，每个文件中有一个工作表”销售情况”，请你在“销售情况”的工作表中，复制出”小龙女”的销售金额，并汇总到一个工作表，计算出“小龙女”这四年来的销售总额
【难点】一个有一个文件，每个文件要打开-----复制“小龙女”的销售金额----粘贴到汇总文件----关闭文件---“不保存”，再来………………，时间要多少。
【解决方法】
用VBA程序，Dir文件夹中的所有文件，workbooks.open每一个文件，Find(“小龙女”),找到它的行，再打这一行的单元格全部赋值给数组。数组的第一列全部保存“文件名“可以知道来源，
【说明】：还好，每个文件中只有一个”小龙女”一行数据，如果是多行，我也不知道怎么办，还没想到。
【代码如下】
Sub test()
Dim wbk As Object, sht_main As Worksheet
Dim mfile As String
Dim arr(1 To 50, 1 To 10)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ti = Timer
i= 0
mfile = Dir(ThisWorkbook.Path & "*.xls*")
Set sht_main = ActiveSheet
Do Until mfile = ""
If mfile <> ThisWorkbook.Name Then
i = i 1
Set wbk = Workbooks.Open(ThisWorkbook.Path & "" &mfile)
With wbk.Sheets("销售情况")
r = .UsedRange.Find("小龙女").Row
'MsgBox mfile &"-----" & r
arr(i, 1) = mfile
For j = 2 To 10
arr(i, j) = .Cells(r, j -1).Value
Next j
End With
wbk.Close flase
Set wbk = Nothing
End If
mfile = Dir
Loop
sht_main.Range("a" & 2).Resize(UBound(arr, 1), UBound(arr,2)).NumberFormat = "@"
sht_main.Range("a" & 2).Resize(UBound(arr, 1), UBound(arr,2)) = arr
MsgBox "汇总完成" & Chr(10) &"共找到了" & i & "个文件" & Chr(10) & "用时："& Format(Timer - ti, "00.00秒")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
======保存起来，以便以后的学习=====
