EXCEL VBA相同填充颜色,不同填充颜色

Question

1。填充单元格为红色，不同时填充单元格为黄色

Answer 1

这么简单，用“公式+条件格式”不行吗？
假设数据在A列，A1起：
选A列——菜单栏——格式——条件格式——公式：
=COUNTIF(A:A,A1)>1
——格式——图案——颜色：红色——确定——添加——公式：
=COUNTIF(A:A,A1)=1
——格式——图案——颜色：黄色——确定——确定。

不止1列的一个矩阵，如A:D列，修改公式引用就行：
=COUNTIF($A:$D,A1)>1
=COUNTIF($A:$D,A1)=1

Answer 2

Sub xx()
  a = [k7] 'J5在这里修改
  Set Rng = [l41:l46] '范围在这里修改
  For i = 1 To Rng.Count
    If Rng.Item(i) = a Then
      Rng.Item(i).Offset(0, 1).Interior.Color = vbRed
    Else
      Rng.Item(i).Offset(0, 1).Interior.Color = vbYellow
    End If
  Next
End Sub

追问

再次执行时,填充另一单元(也就是右边单元:以此类推)

追答Sub xx()
  a = [k7] 'J5在这里修改
  Set Rng = [l41:l46] '范围在这里修改
  b = 1
  Do While Rng.Item(1).Offset(0, b).Interior.ColorIndex <> xlNone
    b = b + 1
  Loop
  For i = 1 To Rng.Count
    If Rng.Item(i) = a Then
      Rng.Item(i).Offset(0, b).Interior.Color = vbRed
    Else
      Rng.Item(i).Offset(0, b).Interior.Color = vbYellow
    End If
  Next
End Sub

追问

它隔了一列再填充了
还有就是没有填充红色

追答Sub xx()
  a = [k7] 'J5在这里修改
  Set Rng = [l41:l46] '范围在这里修改
  b = 1
  Do While Rng.Item(1).Offset(0, b).Interior.ColorIndex <> xlNone
    b = b + 1
  Loop
  For i = 1 To Rng.Count
    If Rng.Item(i) = a Then
      Rng.Item(i).Offset(0, b).Interior.Color = vbRed
    Else
      Rng.Item(i).Offset(0, b).Interior.Color = vbYellow
    End If
  Next
End Sub

本回答被提问者采纳