这个除了用VBA还能其他办法实现吗？

lcxq120713

需求在压缩包

ykcbf1100

你这个还有标红处理，公式解决不了吧，估计还得VBA。

ykcbf1100

VBA写一个

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.9.20
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = 23     'Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 2)
   
5.     Cells.Font.ColorIndex = 0
   
6.     For i = 2 To UBound(arr)
   
7.         s = Split(arr(i, 1), "-")(0)
   
8.         d(s) = d(s) + arr(i, 2)
   
9.         If d(s) > 10 Then
   
10.             Cells(i, 2).Font.ColorIndex = 3
    
11.         End If
    
12.     Next
    
13. End Sub
    

复制代码

lcxq120713

    还要以此类推

ykcbf1100

lcxq120713 发表于 2024-9-20 11:38
还要以此类推

原代码就可以做到的，只要r值根据实际改一下就行了。

你到底有没有运行过啊。

lcxq120713

ykcbf1100 发表于 2024-9-20 12:51
原代码就可以做到的，只要r值根据实际改一下就行了。

你到底有没有运行过啊。

好的谢谢！可以了