ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微视频教程 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 143|回复: 10

[求助] 求助各位,怎么将每月的汇总表转成每个人的汇总表?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-12-7 09:35 | 显示全部楼层 |阅读模式
求助各位,怎么将每月的汇总表转成每个人的汇总表?小弟实在是弄不来,试了好多办法。麻烦各位了。具体需求是这样的:

将每个月的生产情况表,如1月,2月,3月.....见下图:

整理成每个人的生产情况汇总表,如下图:

不知道用什么好的办法可以办到,求各位解答下。。。拜托了。

TA的精华主题

TA的得分主题

发表于 2017-12-7 09:59 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-7 10:21 | 显示全部楼层
lgcmeli 发表于 2017-12-7 09:59
得提供附件,才好说话

附件.rar (25.81 KB, 下载次数: 19)

TA的精华主题

TA的得分主题

发表于 2017-12-7 10:30 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-7 10:39 | 显示全部楼层
LMY123 发表于 2017-12-7 10:30
合并多薄单表,单条件

具体怎么做啊。。。能不能稍微指导下。。。

TA的精华主题

TA的得分主题

发表于 2017-12-7 11:03 | 显示全部楼层
数据多的话用合并表 数据不多手动操作到一个表里 再用公式就行了
合并表vb在论坛里搜索

TA的精华主题

TA的得分主题

发表于 2017-12-7 12:26 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-12-7 13:31 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-12-8 10:27 | 显示全部楼层
不要删除   汇总表   文件夹,结果就在这个文件夹内
附件.rar (67.66 KB, 下载次数: 28)

TA的精华主题

TA的得分主题

发表于 2017-12-8 10:27 | 显示全部楼层
Sub 拆分为独立工作薄()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb, wb1 As Excel.Workbook
Dim sh As Excel.Worksheet
Dim d As Object
Dim arr As Variant
Set d = CreateObject("scripting.dictionary")
   arr = Worksheets(2).UsedRange
   For i = 2 To UBound(arr)
   d(arr(i, 2)) = i
   Next i
   Application.SheetsInNewWorkbook = 1
   For Each k In d.keys
   ReDim BRR(1 To 120, 1 To UBound(arr, 2) + 1)
   n = 0
    For i = 2 To UBound(arr)
    If arr(i, 2) = k Then
    n = n + 1
      BRR(n, 1) = arr(i, 1)
    For j = 3 To UBound(arr, 2)
    BRR(n, j - 1) = arr(i, j)
    Next j
    End If
    Next i
   Set wb = Workbooks.Add
   With wb.Worksheets(1)
   .[a1].Resize(1, 6) = Array("月份", "A工序用时", "B工序用时", "C工序用时", "D工序用时", "E工序用时")
    .[A2].Resize(n, 6) = BRR
    End With
    wb.SaveAs Filename:=ThisWorkbook.Path & "\汇总表\" & k & "汇总表.xls"
    wb.Close
    Next k
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
End Sub

Sub 汇总()
Application.ScreenUpdating = False
Dim wb, wb1 As Excel.Workbook
Dim sh As Excel.Worksheet
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set sh = ThisWorkbook.Worksheets(2)
sh.UsedRange.ClearContents
f = Dir(ThisWorkbook.Path & "\*.xls*") '生成查找EXCEL的目录,可以适应不同版本
Do While f <> "" '在目录中循环
If f <> ThisWorkbook.Name Then  '如果不是打开的工作簿
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f) '依次打开目录工作薄
rr = wb.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    arr = wb.Worksheets(1).Range("a4:f" & rr)
  R = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
  sh.Cells(R, 2).Resize(UBound(arr), UBound(arr, 2)) = arr
   sh.Cells(R, 1).Resize(UBound(arr)) = Split(wb.Name, ".")(0)
    wb.Close False '关闭打开的工作薄
    End If
    f = Dir
    Loop '结束循环
    拆分为独立工作薄
    Application.ScreenUpdating = True
End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天坐享新鲜教程

手机版|关于我们|联系我们|ExcelHome   

GMT+8, 2017-12-17 10:13 , Processed in 1.074692 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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