求助匹配数据并自动填充颜色

跨越时空

求助匹配数据并自动填充颜色.zip (7.96 KB, 下载次数: 8)

2025-1-12 17:17 上传

点击文件名下载附件

ykcbf1100

附件供参考。。。

ykcbf1100

。。。。。。。。。。

跨越时空

ykcbf1100 发表于 2025-1-12 17:31
参与一下。。。

感谢帮助，代码还有点问题，与原附件填充的颜色还不一样，请老师帮忙再优化下代码，谢谢！

ykcbf1100

跨越时空 发表于 2025-1-12 18:14
感谢帮助，代码还有点问题，与原附件填充的颜色还不一样，请老师帮忙再优化下代码，谢谢！

是我想错了，我重写一下吧

跨越时空

ykcbf1100 发表于 2025-1-12 18:22
颜色不用完全一样吧，只不过用来区分一下而已。

感谢老师的帮助，不是颜色要一样，是符合条件的项A与F列没有成对填充颜色，逻辑还有问题，细看下数据就能发现这个问题，谢谢！

跨越时空

跨越时空 发表于 2025-1-12 18:29
感谢老师的帮助，不是颜色要一样，是符合条件的项A与F列没有成对填充颜色，逻辑还有问题，细看下数据就能 ...

A列中有可能会有重复出现的品号，F列也可能有，但只要不是A列有的品号，F列也有相同的品号就不能填充颜色，因此用字典可能不合适，谢谢！

ykcbf1100

重写一个。

1. Sub ykcbf()   '//2025.1.12
   
2.     Application.ScreenUpdating = False
   
3.     arr = [a1].CurrentRegion
   
4.     brr = [f1].CurrentRegion
   
5.     Cells.Interior.ColorIndex = 0
   
6.     For i = 2 To UBound(brr)
   
7.         For x = 2 To UBound(arr)
   
8.             If brr(i, 1) = arr(x, 1) Then
   
9.                 If brr(i, 2) = arr(x, 2) Then
   
10.                     Cells(i, 6).Interior.ColorIndex = 4
    
11.                     Cells(x, 1).Interior.ColorIndex = 4
    
12.                 Else
    
13.                     Cells(i, 6).Interior.ColorIndex = 3
    
14.                     Cells(x, 1).Interior.ColorIndex = 3
    
15.                 End If
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     Application.ScreenUpdating = True
    
20.     MsgBox "OK！"
    
21. End Sub
    

复制代码

ykcbf1100

跨越时空 发表于 2025-1-12 18:29
感谢老师的帮助，不是颜色要一样，是符合条件的项A与F列没有成对填充颜色，逻辑还有问题，细看下数据就能 ...

已重写。。。

gwjkkkkk