统计领料周期

看飞鸟的金鱼

统计总表的领料周期

ykcbf1100

如果只领用一次，那算几天？

看飞鸟的金鱼

就不用统计

看飞鸟的金鱼

ykcbf1100 发表于 2024-5-19 19:23
如果只领用一次，那算几天？

就是想统计每种物料每次领料的间隔天数，也可以其它形式表现出来。

gwjkkkkk

Option Explicit

Sub test1()
    Dim ar(), br(), cr$(), i&, j&, n&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = Sheets(2).[a1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        vKey = ar(i, 2)
        dic(vKey) = dic(vKey) & " " & i
    Next i
   
    For Each vKey In dic.keys
        cr = Split(dic(vKey))
        If UBound(cr) > 1 Then
            ReDim br(1 To UBound(cr), 1 To UBound(ar, 2))
            For i = 1 To UBound(cr)
                For j = 1 To UBound(ar, 2)
                    br(i, j) = ar(cr(i), j)
                Next j
            Next i
            qsort br, 1, UBound(br), 1, UBound(br, 2)
            dic(vKey) = br
        Else
            dic.Remove vKey
        End If
    Next
   
    With [a1].CurrentRegion
        .Offset(1, 3).Clear
        ar = .Value
        For i = 2 To UBound(ar)
            vKey = ar(i, 2)
            If dic.exists(vKey) Then
                n = 3
                br = dic(vKey)
                For j = 2 To UBound(br)
                    n = n + 1
                    ar(i, n) = br(j, 1) - br(j - 1, 1)
                Next j
            End If
            .Value = ar
        Next i
    End With
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
   
End Sub
Function qsort(ByRef ar, ByVal iFirst&, ByVal iLast&, ByVal iLeft&, _
    ByVal iRight, Optional ByVal iKey& = 1, Optional isOrder As Boolean = True)
   
    Dim i&, j&, k&, vTemp1, vTemp2
   
    i = iFirst: j = iLast: vTemp1 = ar((iFirst + iLast) / 2, iKey)
    While i <= j
        If isOrder Then
            While ar(i, iKey) < vTemp1: i = i + 1: Wend
            While vTemp1 < ar(j, iKey): j = j - 1: Wend
        Else
            While ar(i, iKey) > vTemp1: i = i + 1: Wend
            While vTemp1 > ar(j, iKey): j = j - 1: Wend
        End If
        If i <= j Then
             For k = iLeft To iRight
             vTemp2 = ar(i, k): ar(i, k) = ar(j, k): ar(j, k) = vTemp2
            Next
            i = i + 1: j = j - 1
        End If
    Wend
   
    If iFirst < j Then qsort ar, iFirst, j, iLeft, iRight, iKey, isOrder
    If i < iLast Then qsort ar, i, iLast, iLeft, iRight, iKey, isOrder
End Function

gwjkkkkk

。。。。。。。。。。。。。

Qs18

是具体的材料周期吗？好像没有理解到意思，最好是举例子

天真无鞋

周期一年52周，或者53周，每7天为一个周期，但是好像每个周期的计算点会有点出入，有的星期六对星期六，有的星期日对星期日。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.19
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("领料明细")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a2].Resize(r - 1, 10)
   
6.         sort2 arr, 1, 1
   
7.     End With
   
8.     For i = 1 To UBound(arr)
   
9.         s = arr(i, 2) & "|" & arr(i, 6)
   
10.         If Not d.exists(s) Then
    
11.             d(s) = arr(i, 1)
    
12.         Else
    
13.             d(s) = d(s) & "|" & arr(i, 1)
    
14.         End If
    
15.     Next
    
16.     t = d.items
    
17.     ReDim brr(1 To d.Count, 1 To 100)
    
18.     On Error Resume Next
    
19.     For Each k In d.keys
    
20.         m = m + 1
    
21.         brr(m, 1) = m
    
22.         brr(m, 2) = Split(k, "|")(0)
    
23.         brr(m, 3) = Split(k, "|")(1)
    
24.         t = d(k)
    
25.         c = 3
    
26.         If InStr(t, "|") Then
    
27.             b = Split(t, "|")
    
28.             For x = 1 To UBound(b)
    
29.                 c = c + 1
    
30.                 brr(m, c) = CLng(CDate(b(x))) - CLng(CDate(b(x - 1)))
    
31.             Next
    
32.         End If
    
33.     Next
    
34.     With Sheets("总表")
    
35.         .UsedRange.Offset(1) = ""
    
36.         .[a2].Resize(m, 100) = brr
    
37.     End With
    
38.     MsgBox "OK！"
    
39. End Sub

复制代码