请选择 进入手机版 | 继续访问电脑版
设为首页收藏本站

共享社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

搜索
热搜: 活动 交友 discuz
查看: 724|回复: 3

[求助] 求高手指教怎么统计在不同工作簿里面的耗材和五金

[复制链接]

5

主题

12

帖子

23

积分

论坛建设者

Rank: 7Rank: 7Rank: 7

威望
0
金钱
39
贡献
1
发表于 2015-11-4 13:05:07 | 显示全部楼层 |阅读模式
求高手指教怎么统计在不同工作簿里面的耗材和五金进行汇总,
1将附件里面的说有工作薄的工作表里面的有表格里面的数据拷贝在一个新建工作簿里面《如果可以把数据拷贝出来也可以,拷贝出来后后面的我会弄》
2将拷贝出来的数据进行汇总,数据源是在五金里面就统计在五金里面,数据源是在耗材里面就统计在耗材里面
我的这种表格很多说以求一个好的方法
PQK%3%PSX7%QF_P7WLZZWSI.png
PV3`)4TNEQJD[S9TX27X642.jpg

测试总汇宏.zip

75.57 KB, 下载次数: 10

回复

使用道具 举报

12

主题

59

帖子

188

积分

排长

Rank: 2

威望
4
金钱
294
贡献
5
发表于 2015-11-4 14:52:36 | 显示全部楼层
Sub H玻璃统计()
Dim files
Dim Myr
Dim a&, b&, M%, i%, super, n, namer, rn
Dim SHT As Worksheet, Chjs As Worksheet
Dim Wb As Workbook
Dim t As Integer, s As Integer
Dim arr As Variant, r As Integer, h As Long, fn As String
Dim WK As Workbook
Dim WS As Worksheet
n = 1
h = 2
Application.ScreenUpdating = False

files = Application.GetOpenFilename("所有文件(*.xlsx),*.xlsx", , , , True)
If Not IsArray(files) Then
    'MsgBox "没有选定工作薄!", 64, "Ztools"
    Exit Sub
End If
Set WK = Workbooks.Add
Set WS = WK.Sheets(1)
WS.Name = "统计"
WS.Cells(1, 1).Resize(1, 7) = Array("序号", "名称", "规格 ", "单位", "数量", "备注", "表名")
For i = LBound(files) To UBound(files)
    Set Wb = Workbooks.Open(files(i))
    ActiveWindow.DisplayZeros = False
    namer = Wb.Name
    Application.StatusBar = "正在处理:" & namer & "...."
    r = ActiveWorkbook.Sheets(2).Range("m:q").Find("*", , xlValues, , , xlPrevious).Row - 2
    Myr = Range("m3").Resize(r, 7)
    For rn = 1 To UBound(Myr)
        Myr(rn, 6) = namer
    Next rn
    WS.Range("b" & h).Resize(r, 7) = Myr
    n = n + 1
    h = h + r
    Wb.Close False
Next i
M = WS.Range("B65536").End(xlUp).Row
Range("A" & M).ClearContents
For s = 2 To M
    t = t + 1
    Range("A" & s) = t
Next
ActiveWindow.Zoom = 85
WS.Activate
    Range("A1:G1").Font.Bold = True
With WS.UsedRange
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    .EntireColumn.AutoFit
End With
WS.UsedRange.Borders(xlDiagonalDown).LineStyle = xlNone
WS.UsedRange.Borders(xlDiagonalUp).LineStyle = xlNone
With WS.UsedRange.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With WS.UsedRange.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With WS.UsedRange.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With WS.UsedRange.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With WS.UsedRange.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With WS.UsedRange.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Application.StatusBar = "汇总完毕!"
Application.ScreenUpdating = True
'MsgBox "汇总完毕,请查看!", 64, "提示"
End Sub
代码拿以前的程序改的其实录的宏简化一下很简单 忙 没空弄了 供参考吧 批量数据汇总1.gif

回复 支持 反对

使用道具 举报

12

主题

59

帖子

188

积分

排长

Rank: 2

威望
4
金钱
294
贡献
5
发表于 2015-11-4 14:54:20 | 显示全部楼层
请参考如下附件

供参考.zip

15.84 KB, 下载次数: 4

回复 支持 反对

使用道具 举报

39

主题

125

帖子

142

积分

排长

Rank: 2

威望
0
金钱
253
贡献
0
发表于 2015-11-23 08:56:35 | 显示全部楼层
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Archiver|共享社区 ( 京ICP备15025663号-2  

GMT+8, 2018-12-11 08:02 , Processed in 0.162197 second(s), 24 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表