文件夹中多工作薄指定工作表中提取指定字符的数据

文件夹中多工作薄指定工作表中提取指定字符的数据

【问题描述】一个文件夹中有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

======保存起来，以便以后的学习=====