[已解决]VBA怎么实现AU-AW列数据等于AP-AR时， AP-AR列字体颜色变红，底色变蓝;

xmgao1021

VBA怎么实现AU-AW列数据等于AP-AR时， AP-AR列字体颜色变红，底色变蓝; 不要用条件格式
最后效果

最佳答案

月排行榜 / 总排行榜

mathking77

2016-7-28 15:50

Sub xx()
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row
If Cells(i, 47) & Cells(i, 48) & Cells(i, 49) = Cells(i, 42) & Cells(i, 43) & Cells(i, 44) Then
   Cells(i, 42).Interior.ColorIndex = 33
   Cells(i, 42).Interior.Pattern = xlSolid
   Cells(i, 42).Font.ColorIndex = 3
   Cells(i, 43).Interior.ColorIndex = 33
   Cells(i, 43).Interior.Pattern = xlSolid
   Cells(i, 43).Font.ColorIndex = 3
   Cells(i, 44).Interior.ColorIndex = 33
   Cells(i, 44).Interior.Pattern = xlSolid
   Cells(i, 44).Font.ColorIndex = 3
End If
Next
End Sub

跳转到最佳答案楼层

mathking77

Sub xx()
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row
If Cells(i, 47) & Cells(i, 48) & Cells(i, 49) = Cells(i, 42) & Cells(i, 43) & Cells(i, 44) Then
   Cells(i, 42).Interior.ColorIndex = 33
   Cells(i, 42).Interior.Pattern = xlSolid
   Cells(i, 42).Font.ColorIndex = 3
   Cells(i, 43).Interior.ColorIndex = 33
   Cells(i, 43).Interior.Pattern = xlSolid
   Cells(i, 43).Font.ColorIndex = 3
   Cells(i, 44).Interior.ColorIndex = 33
   Cells(i, 44).Interior.Pattern = xlSolid
   Cells(i, 44).Font.ColorIndex = 3
End If
Next
End Sub

xmgao1021

mathking77 发表于 2016-7-28 15:50
Sub xx()
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row

{:171:}终于可以实现了，之前用条件格式录制宏会报错，整了好久；，朋友谢啦，帮了好大的忙

luhao1990

mathking77 发表于 2016-7-28 15:50
Sub xx()
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row

楼上的 代码试验有效，但是存在问题 ：首次满足条件单元格和问题填满颜色后，修改原始数据使之不满足条件重新运行程序，填色依然存在

luhao1990

Sub 习题1()
Dim i As Integer
For i = 1 To Range("a65536").End(xlUp).Row
If Cells(i, 1) & Cells(i, 2) & Cells(i, 3) = Cells(i, 5) & Cells(i, 6) & Cells(i, 7) Then
Cells(i, 5).Interior.ColorIndex = 33
Cells(i, 5).Interior.Pattern = xlSolid
Cells(i, 5).Font.ColorIndex = 3
Cells(i, 6).Interior.ColorIndex = 33
Cells(i, 6).Interior.Pattern = xlSolid
Cells(i, 6).Font.ColorIndex = 3
Cells(i, 7).Interior.ColorIndex = 33
Cells(i, 7).Interior.Pattern = xlSolid
Cells(i, 7).Font.ColorIndex = 3
Else
Cells(i, 5).Interior.Pattern = xlNone
Cells(i, 5).Font.ColorIndex = 1
Cells(i, 6).Interior.Pattern = xlNone
Cells(i, 6).Font.ColorIndex = 1
Cells(i, 7).Interior.Pattern = xlNone
Cells(i, 7).Font.ColorIndex = 1

End If
Next

End Sub


应该增加类似 出现不满足条件的情况的设定。
（上文代码不要直接复制）

此外这种处理方式感觉代码运行时间比较长，诚请看到的大神介绍更加优化的方式

xmgao1021

luhao1990 发表于 2016-7-28 17:06
Sub 习题1()
Dim i As Integer
For i = 1 To Range("a65536").End(xlUp).Row

因为我们宏只需要运行一次就可以了，所以比较不会出现更改原始记录的时候；但是现在有个问题
如果遇到有0的情况；能不能不现实0出来，0显示出来整个界面有点乱

xmgao1021

mathking77 发表于 2016-7-28 15:50
Sub xx()
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row

因为我们宏只需要运行一次就可以了，所以比较不会出现更改原始记录的时候；但是现在有个问题
如果遇到有0的情况；能不能不现实0出来，0显示出来整个界面有点乱

mathking77

把0去掉 还是把0改成和背景一样

xmgao1021

mathking77 发表于 2016-8-18 08:48
把0去掉 还是把0改成和背景一样

把0去掉

mathking77

Sub xx()
Dim i&
For i = 1 To Range("A65536").End(xlUp).Row
If Cells(i, 47) & Cells(i, 48) & Cells(i, 49) = Cells(i, 42) & Cells(i, 43) & Cells(i, 44) Then
   Cells(i, 42).Interior.ColorIndex = 33
   Cells(i, 42).Interior.Pattern = xlSolid
   Cells(i, 42).Font.ColorIndex = 3
   Cells(i, 43).Interior.ColorIndex = 33
   Cells(i, 43).Interior.Pattern = xlSolid
   Cells(i, 43).Font.ColorIndex = 3
   Cells(i, 44).Interior.ColorIndex = 33
   Cells(i, 44).Interior.Pattern = xlSolid
   Cells(i, 44).Font.ColorIndex = 3
End If
If Cells(i, 42) = 0 Then
Cells(i, 42).ClearContents
End If
If Cells(i, 43) = 0 Then
Cells(i, 43).ClearContents
End If
If Cells(i, 44) = 0 Then
Cells(i, 44).ClearContents
End If
Next
End Sub