求各位师傅帮忙

快人一步

客户名称和日期不顺序，当某客户金额2大于金额1时，在e列填写出现金额2大于金额1时的次数，假设日期2024/1/1金额2大于金额1时e列填写1，日期2024/1/2又金额2大于金额1时e列填写2，直到金额2小于金额1时e列填写为空，当又出现金额2大于金额1时e列1填如图写怎样操作

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

ynzsvt

1. Sub YnZsVt()  '//2024.11.4
   
2. Set Dic = CreateObject("Scripting.Dictionary")
   
3. Arr = [a1].CurrentRegion
   
4. For i = 2 To UBound(Arr)
   
5.   s = Arr(i, 1)
   
6.   If Arr(i, 4) - Arr(i, 3) > 0 Then
   
7.    Dic(s) = Dic(s) + 1
   
8.   Else
   
9.    Dic(s) = Empty
   
10.   End If
    
11.   Arr(i, 5) = Dic(s)
    
12. Next
    
13. [e1].Resize(UBound(Arr), 1) = Application.Index(Arr, 0, 5)
    
14. End Sub

复制代码

yanglinzi

yanglinzi

请测试。。

快人一步

yanglinzi 发表于 2024-11-4 11:08
请测试。。

先多谢各位师傅，四楼、六楼师傅如果是日期顺序已经能实现，最检查b列日期是否顺序，按客户又按日期顺序计算次数就更好。再次感谢各位。

翁知江安

已基本完成

翁知江安

Sub 填列()
Dim i, j, irow
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
irow = Sheet2.[a65536].End(xlUp).Row
arr = Sheet2.Range("a1:e" & irow)
ReDim brr(1 To irow - 1, 1 To 1)
For i = 2 To irow
   If arr(i, 3) < arr(i, 4) Then
     d(arr(i, 1)) = d(arr(i, 1)) + 1
     brr(i - 1, 1) = d(arr(i, 1))
      Else
        d(arr(i, 1)) = 0
        brr(i - 1, 1) = d(arr(i, 1))
    End If
Next
For j = 1 To UBound(brr)
  If brr(j, 1) = 0 Then
     brr(j, 1) = ""
   End If
Next
Sheet2.[e2].Resize(UBound(brr), 1) = brr
End Sub

翁知江安

我的版本是excel 365 的，以上仅供参考