[已解决]请教，如何根据现有格式，增加J列与K列数据相同时颜色自动改变为红色，对已改变的...

macarons

请教，如何根据现有格式，增加J列与K列数据相同时颜色自动改变为红色，对已改变的项能够自动向上移动到已改变颜色排列， 请教，如何根据现有格式，增加J列与K列数据相同时颜色自动改变为红色，对已改变的项能.rar (5.5 KB, 下载次数: 27)

2012-8-19 16:12 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

银鱼

2012-8-19 23:15

1. 
   
2. Sub xiugai()
   
3.     Dim i, x, y As Integer
   
4.     Dim a, b
   
5.     With Sheets("sheet1")
   
6.         x = 1
   
7.         For i = 3 To .[j65536].End(xlUp).Row
   
8.             If .Cells(i, "j").Value = .Cells(i, "k").Value And .Cells(i, "j") <> "" Then
   
9.                 x = x + 1
   
10.                 .Range(.Cells(i, "j"), .Cells(i, "k")).Font.Color = -16776961
    
11.                  a = .Cells(x, "j")
    
12.                  b = .Cells(x, "k")
    
13.                 .Range(.Cells(i, "j"), .Cells(i, "k")).Copy (.Range(.Cells(x, "j"), .Cells(x, "k")))
    
14.                 If i <> 3 Then
    
15.                     .Range(.Cells(i, "j"), .Cells(i, "k")).Font.Color = xlThemeColorLight1
    
16.                 End If
    
17.                 .Cells(i, "j") = a
    
18.                 .Cells(i, "k") = b
    
19.             End If
    
20.         Next
    
21.     End With
    
22. End Sub
    

复制代码

看看行不行吧，不行就明天再看了

跳转到最佳答案楼层

蓝桥玄霜

J列与K列数据相同时颜色自动改变为红色    这句可以理解；后半句就理解不了了。

macarons

蓝桥玄霜 发表于 2012-8-19 17:13
J列与K列数据相同时颜色自动改变为红色    这句可以理解；后半句就理解不了了。

意思是想把变为绿色的项自动移动集中在顶端，谢谢！

银鱼

1. 
   
2. Sub xiugai()
   
3.     Dim i, x, y As Integer
   
4.     Dim a, b
   
5.     With Sheets("sheet1")
   
6.         x = 2
   
7.         For i = 3 To .[j65536].End(xlUp).Row
   
8.             If .Cells(i, "j").Value = .Cells(i, "k").Value And .Cells(i, "j") <> "" Then
   
9.                 x = x + 1
   
10.                 .Range(.Cells(i, "j"), .Cells(i, "k")).Font.Color = -16776961
    
11.                  a = .Cells(x, "j")
    
12.                  b = .Cells(x, "k")
    
13.                 .Range(.Cells(i, "j"), .Cells(i, "k")).Copy (.Range(.Cells(x, "j"), .Cells(x, "k")))
    
14.                 If i <> 3 Then
    
15.                     .Range(.Cells(i, "j"), .Cells(i, "k")).Font.Color = xlThemeColorLight1
    
16.                 End If
    
17.                 .Cells(i, "j") = a
    
18.                 .Cells(i, "k") = b
    
19.             End If
    
20.         Next
    
21.     End With
    
22. 
    
23. End Sub
    

复制代码

银鱼

我的理解是将变为红色的移到顶部，不知道是不是这个意思。

macarons

银鱼 发表于 2012-8-19 22:26

没有表达清楚，
我想把经有改动变为绿色项自动上移，谢谢！

银鱼

macarons 发表于 2012-8-19 22:54
没有表达清楚，
我想把经有改动变为绿色项自动上移，谢谢！

是把有变化的自动上移啦。

银鱼

最好有一个模拟结果

银鱼

1. 
   
2. Sub xiugai()
   
3.     Dim i, x, y As Integer
   
4.     Dim a, b
   
5.     With Sheets("sheet1")
   
6.         x = 1
   
7.         For i = 3 To .[j65536].End(xlUp).Row
   
8.             If .Cells(i, "j").Value = .Cells(i, "k").Value And .Cells(i, "j") <> "" Then
   
9.                 x = x + 1
   
10.                 .Range(.Cells(i, "j"), .Cells(i, "k")).Font.Color = -16776961
    
11.                  a = .Cells(x, "j")
    
12.                  b = .Cells(x, "k")
    
13.                 .Range(.Cells(i, "j"), .Cells(i, "k")).Copy (.Range(.Cells(x, "j"), .Cells(x, "k")))
    
14.                 If i <> 3 Then
    
15.                     .Range(.Cells(i, "j"), .Cells(i, "k")).Font.Color = xlThemeColorLight1
    
16.                 End If
    
17.                 .Cells(i, "j") = a
    
18.                 .Cells(i, "k") = b
    
19.             End If
    
20.         Next
    
21.     End With
    
22. End Sub
    

复制代码

看看行不行吧，不行就明天再看了