[已解决]提取连续工作七天的员工

diymywork

A表是驾驶员出勤情况；B表是从把A表中出勤超过7天（不含）的人员提取出来；
现在可以写了一段判断出勤超过7天的人员，但是AL列 【最长连续上班天数】 知道如何实现？
如果可以的话，怎么提取到B表呢?

最佳答案

月排行榜 / 总排行榜

grf1973

2015-4-22 13:57

如果某行有几个相同的最大数，这样可以把所有区间提取出来。

1. Sub 统计连续出勤7天以上()
   
2.     arr = Sheet2.[a4].CurrentRegion
   
3.     Dim brr(1 To 1000, 1 To 7)
   
4.     For i = 2 To UBound(arr)
   
5.         smax = 0: s = 0: xstr = "": sjd = ""
   
6.         For j = 6 To UBound(arr, 2)
   
7.             If Len(arr(i, j)) = 0 Then
   
8.                 s = 0: xstr = ""
   
9.             Else
   
10.                 s = s + 1
    
11.                 If s = 1 Then xstr = Format(arr(1, j), "m""月""d""日")
    
12.                 If s = smax Then sjd = sjd & "," & xstr & "-" & Format(arr(1, j), "m""月""d""日")
    
13.                 If s > smax Then smax = s: sjd = xstr & "-" & Format(arr(1, j), "m""月""d""日")
    
14.             End If
    
15.         Next
    
16.         If smax > 7 Then
    
17.             n = n + 1
    
18.             brr(n, 1) = n
    
19.             For k = 2 To 5: brr(n, k) = arr(i, k): Next
    
20.             brr(n, 7) = smax
    
21.             brr(n, 6) = sjd
    
22.         End If
    
23.     Next
    
24.     If n > 0 Then Sheet1.[a3].Resize(n, 7) = brr
    
25. End Sub

复制代码

跳转到最佳答案楼层

张雄友

帮顶，我也有此情况，统计最大交飞天数。

白开水的微笑

1. Sub test()
   
2.     Dim arrData
   
3.     Dim arrResult
   
4.     Dim rowN1       As Long
   
5.     Dim rowN2       As Long
   
6.     Dim colN        As Long
   
7.     Dim colNd       As Long
   
8.     Const colNStart As Long = 6
   
9.     Const colNEnd   As Long = 37
   
10.     Dim blnStart    As Boolean
    
11.     Dim dateStart   As Date
    
12.     Dim dateEnd     As Date
    
13.     Dim WD          As Long
    
14.     Const maxWD     As Long = 7
    
15.    
    
16.     arrData = Sheet2.Range("A4:AJ" & Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row).Value
    
17.    
    
18.     ReDim Preserve arrData(1 To UBound(arrData, 1), 1 To UBound(arrData, 2) + 1)
    
19.     ReDim arrResult(1 To 7, 1 To 1)
    
20.    
    
21.     For rowN1 = 2 To UBound(arrData)
    
22.         WD = 0
    
23.         blnStart = False
    
24.         
    
25.         For colNd = colNStart To colNEnd
    
26.             If Trim(arrData(rowN1, colNd)) <> "" Then
    
27.                 If Not blnStart Then
    
28.                     WD = 1
    
29.                     blnStart = True
    
30.                     dateStart = arrData(1, colNd)
    
31.                 Else
    
32.                     WD = WD + 1
    
33.                 End If
    
34.             Else
    
35.                 If blnStart Then
    
36.                     blnStart = False
    
37.                     If WD >= maxWD Then
    
38.                         dateEnd = arrData(1, colNd - 1)
    
39.                         rowN2 = rowN2 + 1
    
40.                         ReDim Preserve arrResult(1 To 7, 1 To rowN2)
    
41.                         For colN = 1 To 5
    
42.                             arrResult(colN, rowN2) = arrData(rowN1, colN)
    
43.                         Next colN
    
44.                         arrResult(6, rowN2) = dateStart & "~" & dateEnd
    
45.                         arrResult(7, rowN2) = WD
    
46.                     End If
    
47.                 End If
    
48.                 WD = 0
    
49.             End If
    
50.         Next colNd
    
51.         
    
52.     Next rowN1
    
53.    
    
54.     ReDim arrData(1 To UBound(arrResult, 2), 1 To UBound(arrResult, 1))
    
55.     For rowN1 = 1 To UBound(arrData)
    
56.         For colN = 1 To UBound(arrData, 2)
    
57.             arrData(rowN1, colN) = arrResult(colN, rowN1)
    
58.         Next colN
    
59.     Next rowN1
    
60.     Sheet1.Range("A3:G" & Sheet1.Rows.Count).ClearContents
    
61.     Sheet1.Range("A3").Resize(UBound(arrData, 1), UBound(arrData, 2)) = arrData
    
62.     Sheet1.Activate
    
63. End Sub

复制代码

张雄友

白开水的微笑 发表于 2015-4-21 21:15

如果只要最大连续天数，要怎么做：
如：

詹学斌

提取了二条记录，一次9天，一次12天，怎么不要9天的，只要提取最大值12天的那一条？谢谢！

张雄友

白开水的微笑 发表于 2015-4-21 21:15

应该是： Const maxWD     As Long = 7

不能这样等于7了，而是定义一个最大连续最大值在这里才行。

grf1973

为什么要这么复杂呢，简单一点不好吗

1. Sub 统计连续出勤7天以上()
   
2.     arr = Sheet2.[a4].CurrentRegion
   
3.     Dim brr(1 To 1000, 1 To 7)
   
4.     For i = 2 To UBound(arr)
   
5.         smax = 0: s = 0
   
6.         For j = 6 To UBound(arr, 2)
   
7.             If Len(arr(i, j)) = 0 Then
   
8.                 s = 0
   
9.             Else
   
10.                 s = s + 1
    
11.                 If s > smax Then smax = s
    
12.             End If
    
13.         Next
    
14.         If smax > 7 Then
    
15.             n = n + 1
    
16.             brr(n, 1) = n
    
17.             For k = 2 To 5: brr(n, k) = arr(i, k): Next
    
18.             brr(n, 7) = smax
    
19.         End If
    
20.     Next
    
21.     If n > 0 Then Sheet1.[a3].Resize(n, 7) = brr
    
22. End Sub
    

复制代码

张雄友

grf1973 发表于 2015-4-22 11:12
为什么要这么复杂呢，简单一点不好吗

F列的时间段没有提取出来。

grf1973

1. Sub 统计连续出勤7天以上()
   
2.     arr = Sheet2.[a4].CurrentRegion
   
3.     Dim brr(1 To 1000, 1 To 7)
   
4.     For i = 2 To UBound(arr)
   
5.         smax = 0: s = 0: xstr = ""
   
6.         For j = 6 To UBound(arr, 2)
   
7.             If Len(arr(i, j)) = 0 Then
   
8.                 s = 0: xstr = ""
   
9.             Else
   
10.                 s = s + 1
    
11.                 xstr = xstr & "," & Format(arr(1, j), "m""月""d""日")
    
12.                 If s > smax Then smax = s: sjd = xstr
    
13.             End If
    
14.         Next
    
15.         If smax > 7 Then
    
16.             n = n + 1
    
17.             brr(n, 1) = n
    
18.             For k = 2 To 5: brr(n, k) = arr(i, k): Next
    
19.             brr(n, 7) = smax
    
20.             xrr = Split(sjd, ",")
    
21.             brr(n, 6) = xrr(1) & "-" & xrr(UBound(xrr))
    
22.         End If
    
23.     Next
    
24.     If n > 0 Then Sheet1.[a3].Resize(n, 7) = brr
    
25. End Sub

复制代码

grf1973

或者这样

1. Sub 统计连续出勤7天以上()
   
2.     arr = Sheet2.[a4].CurrentRegion
   
3.     Dim brr(1 To 1000, 1 To 7)
   
4.     For i = 2 To UBound(arr)
   
5.         smax = 0: s = 0: xstr = ""
   
6.         For j = 6 To UBound(arr, 2)
   
7.             If Len(arr(i, j)) = 0 Then
   
8.                 s = 0: xstr = ""
   
9.             Else
   
10.                 s = s + 1
    
11.                 If s = 1 Then xstr = Format(arr(1, j), "m""月""d""日")
    
12.                 If s > smax Then smax = s: sjd = xstr & "-" & Format(arr(1, j), "m""月""d""日")
    
13.             End If
    
14.         Next
    
15.         If smax > 7 Then
    
16.             n = n + 1
    
17.             brr(n, 1) = n
    
18.             For k = 2 To 5: brr(n, k) = arr(i, k): Next
    
19.             brr(n, 7) = smax
    
20.             brr(n, 6) = sjd
    
21.         End If
    
22.     Next
    
23.     If n > 0 Then Sheet1.[a3].Resize(n, 7) = brr
    
24. End Sub

复制代码

grf1973

如果某行有几个相同的最大数，这样可以把所有区间提取出来。

1. Sub 统计连续出勤7天以上()
   
2.     arr = Sheet2.[a4].CurrentRegion
   
3.     Dim brr(1 To 1000, 1 To 7)
   
4.     For i = 2 To UBound(arr)
   
5.         smax = 0: s = 0: xstr = "": sjd = ""
   
6.         For j = 6 To UBound(arr, 2)
   
7.             If Len(arr(i, j)) = 0 Then
   
8.                 s = 0: xstr = ""
   
9.             Else
   
10.                 s = s + 1
    
11.                 If s = 1 Then xstr = Format(arr(1, j), "m""月""d""日")
    
12.                 If s = smax Then sjd = sjd & "," & xstr & "-" & Format(arr(1, j), "m""月""d""日")
    
13.                 If s > smax Then smax = s: sjd = xstr & "-" & Format(arr(1, j), "m""月""d""日")
    
14.             End If
    
15.         Next
    
16.         If smax > 7 Then
    
17.             n = n + 1
    
18.             brr(n, 1) = n
    
19.             For k = 2 To 5: brr(n, k) = arr(i, k): Next
    
20.             brr(n, 7) = smax
    
21.             brr(n, 6) = sjd
    
22.         End If
    
23.     Next
    
24.     If n > 0 Then Sheet1.[a3].Resize(n, 7) = brr
    
25. End Sub

复制代码