求大神帮忙，看看用什方法找出名称列相同的数据，并标记颜色

JIUYINI

求大神帮忙，看看用什方法找出名称列相同的数据，并标记颜色

jokklx

Sub aa()
Range("b:b").Interior.Pattern = xlPatternNone
For i = 2 To Range("b" & Rows.Count).End(xlUp).Row
    If Application.WorksheetFunction.CountIf(Range("b:b"), Range("b" & i)) > 1 Then
        Range("b" & i).Interior.Color = yellow
    End If
Next
End Sub

洋务德雷

查找替换功能

JIUYINI

jokklx 发表于 2021-12-30 18:17
Sub aa()
Range("b:b").Interior.Pattern = xlPatternNone
For i = 2 To Range("b" & Rows.Count).End(xl ...

老师您好！我测试了，您这个方法不错，有两个问题能不能帮忙修改一下。
1，填充的颜色是黑色，可不可以改为其他颜色
2.只有B列的对里啦，其它列的没有。

dajiashiren

1. Sub dd()
   
2. Cells.Interior.ColorIndex = xlNone
   
3. Dim arr, d
   
4. arr = Range("b2:q" & Range("a65536").End(xlUp).Row)
   
5. Set d = CreateObject("scripting.dictionary")
   
6. For a = 1 To UBound(arr) Step 4
   
7.     For b = 1 To UBound(arr, 2) Step 5
   
8.         If arr(a, b) <> "" Then
   
9.             d(arr(a, b)) = d(arr(a, b)) + 1
   
10.         End If
    
11.     Next
    
12. Next
    
13. For a = 1 To UBound(arr) Step 4
    
14.     For b = 1 To UBound(arr, 2) Step 5
    
15.         If d(arr(a, b)) > 1 Then
    
16.             Cells(a + 1, b + 1).Interior.ColorIndex = 4
    
17.         End If
    
18.     Next
    
19. Next
    
20. End Sub
    

复制代码

jokklx

JIUYINI 发表于 2021-12-30 18:56
老师您好！我测试了，您这个方法不错，有两个问题能不能帮忙修改一下。
1，填充的颜色是黑色，可不可以 ...

具体填充什么颜色，开发工具选项卡/录制宏，选中一个单元格，染颜色，停止录制，ALT+F11,查看模块中color具体的值，修改即可。不好意思，yellow，不是个常量，黄色应该是65535，你把yellow修改为65535,。
至于B列，其他列的问题，修改一下列号即可，即把上面“b”中（英文引号中字母，大小写均可）修改为具体的列即可。

JIUYINI

jokklx 发表于 2021-12-30 20:13
具体填充什么颜色，开发工具选项卡/录制宏，选中一个单元格，染颜色，停止录制，ALT+F11,查看模块中color ...

谢谢老师！填充颜色我改了ColorIndex = 27这个是黄色 。我还想请教一下，要是有很多工作表怎么循环。

jokklx

JIUYINI 发表于 2021-12-30 20:17
谢谢老师！填充颜色我改了ColorIndex = 27这个是黄色 。我还想请教一下，要是有很多工作表怎么循环。

for i=1 to sheets.count'从工作表的第一个到最后一个，如果第一个不动，就修改为 2 to sheets.count,以此类推，实现工作表循环功能
sheets(i).range("b:b") '要是涉及不同工作表，要在前面用sheets(1),sheets(2)指定后面的对象属于谁，也可以是sheets('具体的工作表名称')这种格式，具体问题具体分析，灵活使用

JIUYINI

dajiashiren 发表于 2021-12-30 19:23

谢谢老师，效果不错