求助各位大侠帮助编写VBA代码

ljfqaz1 · 发表于 2018-7-25 20:20

判断A列里如果有相同姓名，且横向判断E、F、G、H、列里是否都为空，哪怕其中有一行有数字或字母的话都不做任何改动，如果都为空的话把B、C、D列里的数值清空，同时变成一行，并且在I列里添加“满勤”两个字。

A	B	C	D	E	F	G	H	I	J
姓名	日期	签到时间	签退时间	迟到	早退	半天矿工	全天矿工	出勤情况及事由	科室
张三	2018-3-15	8:10	17:07						材料科
张三	2018-3-16	8:10	17:08						材料科
张三	2018-3-17	8:10	17:09						材料科
张三	2018-3-18	8:10	17:10						材料科
张三	2018-3-19	8:10	17:11						材料科
李四	2018-3-28	8:10	17:12						总务科
李四	2018-3-29	8:10	17:12						总务科
李四	2018-3-30	8:10	17:12						总务科
李四	2018-3-31	8:10	17:12						总务科
李四	2018-4-1	8:10	17:12						总务科
王六	2018-4-2	8:10	17:12	1					办公室
王六	2018-4-3	8:10	17:12		1				办公室
王六	2018-4-9	8:10	17:12				1		办公室
王六	2018-4-10	8:10	17:12						办公室
王六	2018-4-12	8:10	17:12					1	办公室
王六	2018-4-13	8:10	17:12						办公室

ljfqaz1 · 发表于 2018-7-25 20:24

本帖最后由 ljfqaz1 于 2018-7-25 20:26 编辑

下面是想要的结果

A	B	C	D	E	F	G	H	I	J
姓名	日期	签到时间	签退时间	迟到	早退	半天矿工	全天矿工	出勤情况及事由	科室
张三								满勤	材料科
李四								满勤	总务科
王六	2018-4-2	8:10	17:12	1					办公室
王六	2018-4-3	8:10	17:12		1				办公室
王六	2018-4-9	8:10	17:12				1		办公室
王六	########	8:10	17:12						办公室
王六	########	8:10	17:12					1	办公室
王六	########	8:10	17:12						办公室

ljfqaz1 · 发表于 2018-7-25 20:42

盼高手出现

chentonny · 发表于 2018-7-25 22:33

没辙的时候联系QQ837860403

ljfqaz1 · 发表于 2018-7-26 11:17

好心的大侠快来给小妹帮个忙吧

ljfqaz1 · 发表于 2018-7-26 11:21

顶一下顶一下

一把小刀闯天下 · 发表于 2018-7-26 12:30

ljfqaz1 发表于 2018-7-26 11:21
顶一下顶一下

Option Explicit

Sub test()
  Dim arr, i, j, k, kk, n, flag As Boolean
  arr = Range("a2:j" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  ReDim brr(1 To UBound(arr, 1) - 1, 1 To UBound(arr, 2))
  For i = 1 To UBound(arr, 1) - 1
flag = True
For j = i To UBound(arr, 1) - 1
   If flag Then
      For k = 5 To 8
      If arr(j, k) = 1 Then flag = False: Exit For
      Next
   End If
   If arr(j, 1) <> arr(j + 1, 1) Then
      If flag Then
      n = n + 1
      brr(n, 1) = arr(i, 1): brr(n, 9) = "满勤": brr(n, 10) = arr(i, 10)
      Else
      For k = i To j
         n = n + 1
         For kk = 1 To UBound(arr, 2): brr(n, kk) = arr(k, kk): Next
      Next
      End If
      i = j: Exit For
   End If
  Next j, i
  [l2].Resize(UBound(brr, 1), UBound(brr, 2)) = brr '输出位置自己修改一下
End Sub

YZC51 · 发表于 2018-7-26 13:54

老师的代码号强大！

出勤情况及事由.rar (14.87 KB, 下载次数: 4)

ljfqaz1 · 发表于 2018-7-26 15:56

一把小刀闯天下,你好强大，真的好感动，谢谢你的鼎力相助！

ljfqaz1 · 发表于 2018-7-26 15:57

一把小刀闯天下，你好强大，真的好感动，谢谢你的鼎力相助。

		自动登录	找回密码
密码			免费注册

[求助] 求助各位大侠帮助编写VBA代码

评分