→案例需求:
首先,我有一堆待提取的表(每个表里分为加工总表和成本表):
汇总表和分表的数据对应关系如下:
加工总表:
/双击查看大图
成本表:
/双击查看大图
→思路分析:
②有一个稍微难一些的地方,成本表中需要提取的数据行数位置不固定。
我觉得VBA入门的差别就在这了:会不会找规律,并将这些规律转化为代码的逻辑条件。
→代码详解:
Sub 汇总清空之前的数据()
'//弹出窗口,让用户选择需要合并的工作簿
pth = Application.GetOpenFilename("文件(*.xls*),*.xls*", , "请选择文件", , True) 'GetOpenFilename支持通配符,true代表允许多选。
If Not IsArray(pth) Then '如果用户没有选择文件,则返回False,不是数组。
MsgBox "请选择需要汇总的工作簿"
Exit Sub '退出过程
End If
'//
Application.ScreenUpdating = False '禁止刷新,防止屏幕闪烁,提高运行速度
Application.AskToUpdateLinks = False '禁止提示更新链接
Application.DisplayAlerts = False '禁止无关的提示信息
Set thissht = ThisWorkbook.ActiveSheet '把代码工作簿的活动工作表赋值给对象变量thissht
thissht.Range("a2:k10000").ClearContents '清空除标题行以外的原有数据
For i = 1 To UBound(pth) 'GetOpenFilename多选文件的话返回的是一个数组,里面存放的是每个文件的路径,循环数组获取里面的文件路径。
Set wb = Workbooks.Open(pth(i)) '将打开的工作簿赋值给对象变量wb
Set sumsht = wb.Worksheets("加工总表") '将打开的工作簿的【加工总表】sheet赋值给对象变量sumsht
Set chengbensht = wb.Worksheets("成本表") '将打开的工作簿的【成本表】sheet赋值给对象变量sumsht
lastrow = thissht.Cells(thissht.Rows.Count, 1).End(3).Row + 1 '获取代码工作簿已使用的最大行号+1
With thissht 'with结构,简化代码
.Cells(lastrow, 1) = i '序号
.Cells(lastrow, 2) = sumsht.Range("a4") '加工任务
.Cells(lastrow, 3) = sumsht.Range("b4") '材料
.Cells(lastrow, 4) = sumsht.Range("c4") '厚度
.Cells(lastrow, 5) = sumsht.Range("e4") '加工时间
.Cells(lastrow, 6) = sumsht.Range("f4") '零件总数
Set zongji = chengbensht.UsedRange.Find("总计", , xlValues, xlWhole, xlByColumns, xlNext, True, True) 'find方法,查找【总计】关键字所在单元格
.Cells(lastrow, 7) = chengbensht.Cells(zongji.Row, 5) '和【总计】单元格同一行,第5列的数据就是所需要的穿孔个数
.Cells(lastrow, 8) = Replace(chengbensht.Cells(zongji.Row + 1, 5), "元/个", "") '在【总计】单元格下一行,第5列的数据就是所需要的单价
.Cells(lastrow, 9) = chengbensht.Cells(zongji.Row, 6) '理解同上
.Cells(lastrow, 10) = Replace(chengbensht.Cells(zongji.Row + 1, 6), "元/m", "") '理解同上
.Cells(lastrow, 11) = Replace(chengbensht.Cells(zongji.Row + 2, 5), "元", "") '理解同上
'上述几句可以用offset实现。
End With
wb.Close False '关闭打开的工作簿,直接用对象变量wb.clsoe即可。false表示不保存。
Next
Application.ScreenUpdating = True '开启刷新
Application.AskToUpdateLinks = True '开启提示更新链接
Application.DisplayAlerts = True '开启无关的提示信息
MsgBox "完成!"
End Sub
→写在最后:
联系客服