ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 Office 365免费试用,报名现在开始! 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 打造核心竞争力的职场宝典 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 164|回复: 13

[求助] 请大神帮忙把下面考勤的表提取一下

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-7-11 23:30 | 显示全部楼层 |阅读模式
新建个工作表提取部门、工号、姓名、早上打卡的最早时间、晚上打卡的最晚时间,谢谢

考勤1.rar

23.16 KB, 下载次数: 6

考勤表

TA的精华主题

TA的得分主题

发表于 2018-7-12 01:05 | 显示全部楼层
真就纳闷了,现在还有什么样的公司考勤还要用这样的表格?没有系统?再说你要输出什么样的结果倒给模拟下啊?

TA的精华主题

TA的得分主题

发表于 2018-7-12 08:41 | 显示全部楼层
  1. Sub test()
  2.   Dim r%, i%
  3.   Dim arr, brr
  4.   Dim d As Object
  5.   Set d = CreateObject("scripting.dictionary")
  6.   With Worksheets("sheet1")
  7.     r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
  8.     If r Mod 2 = 1 Then
  9.       r = r + 1
  10.     End If
  11.     arr = .Range("a3:ae" & r)
  12.   End With
  13.   For i = 3 To UBound(arr) Step 2
  14.     If Not d.exists(arr(i, 3)) Then
  15.       ReDim brr(1 To 34)
  16.       brr(1) = arr(i, 21)
  17.       brr(2) = arr(i, 3)
  18.       brr(3) = arr(i, 11)
  19.     Else
  20.       brr = d(arr(i, 3))
  21.     End If
  22.     For j = 1 To UBound(arr, 2)
  23.       If Len(arr(i + 1, j)) <> 0 Then
  24.         sj1 = Left(arr(i + 1, j), 5)
  25.         sj2 = Right(arr(i + 1, j), 5)
  26.         If sj1 = sj2 Then
  27.           brr(j + 3) = sj1
  28.         Else
  29.           brr(j + 3) = sj1 & vbLf & sj2
  30.         End If
  31.       End If
  32.     Next
  33.     d(arr(i, 3)) = brr
  34.   Next
  35.   With Worksheets("sheet2")
  36.     .UsedRange.Offset(1, 0).ClearContents
  37.     .Range("a2").Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.items))
  38.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
  39.     .Range("a1:ag" & r).Borders.LineStyle = xlContinuous
  40.   End With
  41. End Sub
复制代码

评分

参与人数 1鲜花 +2 收起 理由
乐乐2006201505 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-7-12 08:42 | 显示全部楼层
楼主连个结果表样式也不给,猜测着写的,供参考。

考勤1.rar

41.8 KB, 下载次数: 8

评分

参与人数 2鲜花 +4 收起 理由
乐乐2006201505 + 2 优秀作品
菜海遨游 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-7-12 09:08 | 显示全部楼层
  1.     Set SHK = Worksheets("考勤表")
  2.     Set SHJ = Worksheets("结果")
  3.     SHJ.Range("A2:AZ1048576").ClearContents
  4.    
  5.     X = 1
  6.     For I = 5 To SHK.Range("A1048576").End(3).Row
  7.         If InStr(Replace(SHK.Cells(I, 1).Value, " ", ""), "工号") > 0 Then
  8.             Rem  提示信息,在状态栏显示
  9.             Application.StatusBar = "当前姓名是:" & SHK.Cells(I, 11).Value
  10.             DoEvents
  11.             
  12.             X = X + 1
  13.             SHJ.Cells(X, 1).Value = SHK.Cells(I, 21).Value
  14.             SHJ.Cells(X, 2).Value = SHK.Cells(I, 3).Value
  15.             SHJ.Cells(X, 3).Value = SHK.Cells(I, 11).Value
  16.             
  17.             For ICOL = 1 To 31
  18.                 If SHK.Cells(I + 1, ICOL).Value <> "" Then
  19.                     A = SHK.Cells(I, ICOL).Value
  20.                     STRX = GetRegStr(SHK.Cells(I + 1, ICOL).Value, "[0-9]{2,2}[:][0-9]{2,2}", 0)
  21.                     ARX = Split(STRX, "|")
  22.                     STRX = ARX(0)
  23.                     If UBound(ARX) > 0 Then
  24.                         STRX = STRX & vbCrLf & ARX(UBound(ARX))
  25.                     End If
  26.                     
  27.                     SHJ.Cells(X, ICOL + 3).Value = STRX
  28.                 End If
  29.             Next
  30.         End If
  31.     Next
复制代码

评分

参与人数 1鲜花 +2 收起 理由
菜海遨游 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-7-12 09:09 | 显示全部楼层
QQ14885553.rar (44.38 KB, 下载次数: 3)

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-12 18:48 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-7-12 19:08 | 显示全部楼层
本帖最后由 不知道为什么 于 2018-7-12 19:28 编辑
菜海遨游 发表于 2018-7-12 18:48
能把打卡的最早时间和最晚时间分两个单元格放么

给新人点提示啊:首先要学会和老师的互动,最基础的方式就是点击评分!这也是对别人付出的尊重!

评分

参与人数 1鲜花 +2 收起 理由
菜海遨游 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-7-12 20:17 | 显示全部楼层
菜海遨游 发表于 2018-7-12 18:48
能把打卡的最早时间和最晚时间分两个单元格放么

这年月,义工也不好做啊,哈哈
老板已经修改,您看,还满意么?
有什么问题,我马上改!

小红花就不敢提了,别扔鸡蛋就好,嘻嘻!!!!
QQ14885553.rar (49.4 KB, 下载次数: 3)

评分

参与人数 1鲜花 +2 收起 理由
菜海遨游 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-12 20:41 | 显示全部楼层
不知道为什么 发表于 2018-7-12 19:08
给新人点提示啊:首先要学会和老师的互动,最基础的方式就是点击评分!这也是对别人付出的尊重!

哈哈,明白,谢谢老师
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

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

关注官方微信,每天学会一个新技能

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

GMT+8, 2018-8-18 12:33 , Processed in 0.116497 second(s), 21 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

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

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

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