请高手帮忙看看，怎么用函数或者VBA实现？

edwin11891

pgp5866 发表于 2024-12-12 12:37

好思路！经检验，数据行数同样不能超出20行。

ming89033447

edwin11891 发表于 2024-12-11 19:48
这里说的数据量，是指同一物料编码下的数据行数，不是数据总行数。如181561501，有6行数据；181561692， ...

我知道，就是同一物料编码可能会有几十几百条数据

titi012

参与一下。。。。。。。

1. Sub test()
   
2.     Dim d1 As Object, d2 As Object, d3 As Object
   
3.     Dim i&, j&, Arr, k
   
4.    
   
5.     i = Cells(Rows.Count, 4).End(xlUp).Row
   
6.     Arr = Range("d2:k" & i)
   
7.     Set d1 = CreateObject("Scripting.Dictionary")
   
8.     Set d2 = CreateObject("Scripting.Dictionary")
   
9.     Set d3 = CreateObject("Scripting.Dictionary")
   
10.    
    
11.     For i = LBound(Arr) To UBound(Arr)
    
12.         d1(Arr(i, 1)) = Arr(i, 5) - Arr(i, 3) + d1(Arr(i, 1))
    
13.         d2(Arr(i, 1)) = Arr(i, 8)
    
14.         d3(Arr(i, 1)) = d3(Arr(i, 1)) & i & ","
    
15.     Next
    
16.    
    
17.     [j:j].Interior.ColorIndex = 0
    
18.     For Each k In d1.keys
    
19.         If d1(k) + d2(k) = 0 Then
    
20.             Arr = Split(d3(k), ",")
    
21.             For i = 0 To UBound(Arr) - 1
    
22.                 Range("J" & Val(Arr(i)) + 1).Interior.ColorIndex = 6
    
23.             Next
    
24.         End If
    
25.     Next
    
26.       
    
27.    
    
28. End Sub

复制代码

titi012

上一个附件。。。。。