|
发表于 2011-10-10 14:21
|
显示全部楼层
本楼为最佳答案
本帖最后由 mxg825 于 2011-10-10 14:25 编辑
回复 commanding05a 的帖子
- Private Sub CommandButton1_Click()
- Const BH As String = "物料名称"
- Const GG As String = "物料类型"
- Const NB As String = "合计数量"
- Const ZBNAME = "总表"
- Dim sh As Worksheet
- Dim rngTEMP, rngLast, temp, ggCell
- Dim fs, f, fl, fc, s, fls, flsE
- Dim WB As Workbook
- Dim She As Object
- Dim Rng As Range
- Dim MYrow&, MYcol
- Set fs = CreateObject("Scripting.FileSystemObject") '创建FileSystemObject对象
- Set f = fs.GetFolder(ThisWorkbook.Path & "\分表") '创建文件夹对象
- Application.DisplayAlerts = False '临时关闭EXCEL 系统提示
- Application.ScreenUpdating = False
- On Error GoTo lab
- Set fls = f.Files '取得文件集合
- With ThisWorkbook
- Set ggCell = getCell(GG, .Sheets(ZBNAME)) '取得物料类型 总表 所在单元格
- Range(ggCell.Offset(1, -6), .Sheets(ZBNAME).Cells(65536, ggCell.Column)).Clear '清空旧数据
- For Each flsE In fls '历遍全部文件
- If InStr(flsE.Name, ".xls") > 0 Then ''避免打开非Excel文件
- Set WB = Workbooks.Open(flsE) '打开工作薄
- Set sh = WB.Sheets(1) '赋值分表 中 第一个工作表
- s = s + 1
- Set rngTEMP = getCell(GG, sh) '取得子表 物料类型 所以单元格
- Set temp = rngTEMP.Offset(1, 0) '上句的下一个单元格
- Do While temp.Value <> ""
- total = total + 1
- ggCell.Offset(total, -5) = total '序号
- ggCell.Offset(total, -6) = getCell(NB, sh).Offset(0, 1) '复制 合计数量
- ggCell.Offset(total, -7) = getCell(BH, sh).Offset(0, 1) '复制 物料名称
-
- temp.Offset(0, -4).Resize(1, 5).Copy '复制 物料类型 区域
- ggCell.Offset(total, -4).PasteSpecial Paste:=xlPasteValues
-
- Set temp = temp.Offset(1, 0)
- Loop
- WB.Close False '关闭被打开工作薄
- Set WB = Nothing '释放对象
- End If
- Next
- MsgBox "共处理了" & s & "工作薄", 64, "提示"
- .Save '保存文件
- End With
- GoTo 100
- lab:
- MsgBox "在总表或其它表中没有找到对应的字段!"
- 100:
- Set ggCell = Nothing
- Set sh = Nothing
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
- Function getCell(str As String, sh As Worksheet) '查找子程序
- Set getCell = sh.Cells.Find(what:=str, lookat:=xlPart)
- End Function
复制代码
|
|