现在的位置: 首页 > 综合 > 正文

Excel编写VBA判断2个值是否相等,然后改变单元格颜色

2013年08月08日 ⁄ 综合 ⁄ 共 1723字 ⁄ 字号 评论关闭

1.excel建立表格。

如图:

2.sheet上面点反键加入vba代码:

'ActiveCell.Row ‘活动单元格所在的行数
'ActiveCell.Column ‘活动单元格所在的列数

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call ChangActiveCellColor
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
    'MsgBox ("回车2")
   'MsgBox Target.Cells.Address
    'MsgBox Range(Target.Cells.Address)
    Dim I As Integer
   
        If Sheet1.Range("A" & ActiveCell.Row - 1).Value <> "" Then
        
            For I = 2 To ActiveCell.Row - 2
            'Range("A" & I) = I
            'MsgBox Range("A" & I)
                
            If Sheet1.Range("A" & ActiveCell.Row - 1).Value = Sheet1.Range("A" & I).Value Then
               'Range(Target.Cells.Address).Interior.Color = RGB(255, 0, 0)
               Sheet1.Range("A" & ActiveCell.Row - 1).Interior.Color = RGB(255, 0, 0) '红
               GoTo con
            Else
               'Range(Target.Cells.Address).Interior.Color = RGB(255, 255, 255)
               Sheet1.Range("A" & ActiveCell.Row - 1).Interior.Color = RGB(255, 255, 255) '白
            End If
            Next
        Else '判断改为空格之后点击回车
            Sheet1.Range("A" & ActiveCell.Row - 1).Interior.Color = RGB(255, 255, 255) '白
        End If
       
End If
con:
End Sub

Private Sub ChangActiveCellColor()
    'MsgBox Target.Cells.Address
    'MsgBox Range(Target.Cells.Address)
    Dim I As Integer
   
    If ActiveCell.Value <> "" Then
    
        For I = 2 To ActiveCell.Row - 1
        'Range("A" & I) = I
        'MsgBox Range("A" & I)
            
        If ActiveCell.Value = Sheet1.Range("A" & I).Value Then
           'Range(Target.Cells.Address).Interior.Color = RGB(255, 0, 0)
           ActiveCell.Interior.Color = RGB(255, 0, 0)
           GoTo con
        Else
           'Range(Target.Cells.Address).Interior.Color = RGB(255, 255, 255)
           ActiveCell.Interior.Color = RGB(255, 255, 255)
        End If
        Next
   
    End If
   
con:
     
End Sub

抱歉!评论已关闭.