求助自动更新数据后加边框

bingtianxuedi3

根据每日数据的变化，自动找到符合条件的区域加边框，其他表格单元格格式保持不变。求VBA解法

半百

不知道你的数据是怎么更新的，所以更新后手动运行吧。

半百

1. Sub test()                                                               
   
2. Application.ScreenUpdating = False                                                               
   
3. For Each sh In Sheets                                                               
   
4.     sh.Select                                                               
   
5.     ActiveSheet.UsedRange.Resize(28).Borders.LineStyle = xlContinuous                                                               
   
6.     For j = 2 To 25 Step 2                                                               
   
7.         If j = 16 Then j = 17                                                               
   
8.         m = 0                                                               
   
9.         For i = 5 To 21                                                               
   
10.             Set Rng = Cells(i, j).Resize(8, 1)                                                               
    
11.             s = Application.Sum(Rng)                                                               
    
12.             If s > m Then m = s: ss = Rng.Address                                                               
    
13.         Next                                                               
    
14.         Range(ss).Borders.ColorIndex = 3                                                               
    
15.         Range(ss).Borders.Weight = xlThick                                                               
    
16.         Range(ss).Borders(12).ColorIndex = 0                                                               
    
17.         Range(ss).Borders(12).Weight = xlThin                                                               
    
18.     Next                                                               
    
19. Next                                                               
    
20. Application.ScreenUpdating = True                                                               
    
21. End Sub                                                               
    

复制代码

bingtianxuedi3

半百 发表于 2024-4-3 13:26

基本上能用，因为我的数据不是很规范，有点小问题，影响不大，感谢大神