简体   繁体   English

单元格上的Excel VBA数据验证已更改

[英]Excel VBA Data Validation on cell changed

I have a worksheet named Employees where I have a column named Department. 我有一个名为雇员的工作表,其中有一个名为部门的列。 I also have a worksheet named Departments where in column AI have all the departments available for Employees. 我还有一个名为部门的工作表,其中在AI列中有可用于员工的所有部门。 I want to validate the Department column of Employees worksheet such as when I write a department in Department column of Employees worksheet, if the department is in Departments worksheet the font color remain the same (black), otherwise the font color change to blue. 我想验证“员工”工作表的“部门”列,例如当我在“员工”工作表的“部门”列中编写部门时,如果该部门在“部门”工作表中,则字体颜色保持不变(黑色),否则字体颜色变为蓝色。

This is what I have until now but I can't manage with the cell on change event. 这是我到目前为止所拥有的,但是我无法处理更改事件单元。

Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim j As Integer
    Dim aux As Integer
    Dim count As Integer

    For i = 2 To 301
        For j = 1 To 4
            If Sheet13.Range("H" & i).Value = Sheet14.Range("A" & j) Then
                aux = 1
                Exit For

            Else
                Sheet13.Range("H" & i).Font.ThemeColor = 5
            End If
        Next
        If aux = 1 Then
            Sheet13.Range("H" & i).Font.ThemeColor = 2
            aux = 0
        End If
    Next
End Sub

Try using something like this: 尝试使用如下所示的内容:

Private Sub Worksheet_Change(ByVal Target As Range)
dim rng as Range

set rng = Sheets(1).cells(1,1) ' Change this equal to the range you want to monitor

If Not Intersect(Target, rng) Is Nothing Then

' Place the code you want to run here

End If

End Sub

Remembering to place this in the worksheet code (not in a separate module) 记住将其放置在工作表代码中(而不是在单独的模块中)

I did some research and I managed to validate the data. 我做了一些研究,然后设法验证了数据。 Here is my code: 这是我的代码:

Dim o As Integer
Dim p As Integer
Dim aux As Integer
Dim count14 As Integer
Dim count13 As Integer
Dim KeyCells As Range
Set KeyCells = Range("A1:M301")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then
    count13 = Sheet13.Cells(Rows.count, 8).End(xlUp).Row
    For o = 0 To count13 - 1
        count14 = Sheet14.Cells(Rows.count, 1).End(xlUp).Row
        For p = 1 To count14
            If Sheet13.Range("H" & (o + 2)).Value = Sheet14.Range("A" & p) Then
                aux = 1
                Exit For

            Else
                Sheet13.Range("H" & (o + 2)).Font.ThemeColor = 6
            End If
        Next
        If aux = 1 Then
            Sheet13.Range("H" & (o + 2)).Font.ThemeColor = 2
            aux = 0
        End If
    Next
End If

Hope it's helpful. 希望对您有所帮助。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM