时间戳

首页 > 解决方案 > VBA Excel - 更改一个单元格中的文本会更改另一个数据验证中的文本

excel - VBA Excel - 更改一个单元格中的文本会更改另一个数据验证中的文本

问题描述

我一直在寻找这个问题的答案。

我有一个包含三个由数据验证控制的单元格的工作表，该单元格包含员工姓名。

单元格标题是：

Personnel
Unallocated
On Leave

未分配的单元格列出了所有人员：

AARON MARQUIS
AIDAN MULLIGAN
CRAIG WILKINSON
CRISTIANO BORTOT
DEAN SHELFORD
DREW JOINES
GAVIN SHAW
HAYDEN THOMPSON
JAKE MOONEY
JASON MCGLYNN
JOHN MURPHY
MICHAEL VOGEL
NICHOLAS MADDERN
SEAMUS FEE
SEAN BLAKE
TRENT LAWRENCE

当用户使用下拉列表（数据验证）填充人员和休假单元格时，我想更新此单元格

换句话说，如果用户使用 Data Validation 下拉列表中的 Personnel 名称填充 Personnel 单元格，则 Unallocated 单元格会从单元格中删除该名称，这也适用于 On Leave 单元格。

任何帮助将不胜感激。

我用于数据验证的代码是：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo ExitSub

If Target.Column = 6 Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo ExitSub
    Else: If Target.Value = "" Then GoTo ExitSub Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
        If Oldvalue = "" Then
            Target.Value = Newvalue
        Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbLf & Newvalue
        Else
            Target.Value = Oldvalue
        End If
    End If
End If
End If
ExitSub:
Application.EnableEvents = True
End Sub

标签： excelvalidationvba

解决方案

第一个提示：而不是Else: If，只需使用ElseIf. 详细说明：

If val1 Then
    Action1
Else: If val2 Then
    Action2
End If
End If

和写一样

If val1 Then
    Action1
ElseIf val2 Then
    Action2
End If

（:与开始换行具有相同的效果，因此相反的_是“在下一行继续”）

现在，当您填充一个单元格时，您想要更改另一个单元格的值，您需要在某处定义它 - 这是一个简单的示例，您需要对其进行修改以适应特定工作表的怪癖：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub 'Only change 1 cell
    If Target.Column <> 6 Then Exit Sub 'Column F only
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub 'Drop-Downs only

    Dim OldValue As String, NewValue As String, TempValue As String
    Dim rPersonnel As Range, rUnallocated As Range, rOnLeave As Range

    Application.EnableEvents = False

    Set rPersonel = Me.Cells(1, 6) 'Cell F1
    Set rUnallocated = Me.Cells(2, 6) 'Cell F2
    Set rOnLeave = Me.Cells(3, 6) 'Cell F3

    If Not Intersect(Target, Union(rPersonnel, rOnLeave)) Is Nothing Then
        NewValue = Target.Value
        Application.Undo
        OldValue = Target.Value
        If OldValue = "" Then
            Target.Value = NewValue
        ElseIf InStr(1, OldValue, NewValue) = 0 Then
            Target.Value = OldValue & vbLf & NewValue
        Else
            Target.Value = OldValue
        End If

        TempValue = Replace(Replace(rUnallocated.Value, NewValue, ""), vbLf & vbLf, vbLf) 'Remove from Unallocated and remove double-linebreaks
        TempValue = Replace(Replace(Replace("|" & TempValue & "|", "|" & vbLf, ""), vbLf & "|", ""), "|", "") 'Remove start/end linebreak
        rUnallocated.Value = TempValue
    End If

    If Not Intersect(Target, rPersonnel) Is Nothing Then 'You changed the "Personnel" list
        TempValue = Replace(Replace(rOnLeave.Value, NewValue, ""), vbLf & vbLf, vbLf) 'Remove from On Leave and remove double-linebreaks
        TempValue = Replace(Replace(Replace("|" & TempValue & "|", "|" & vbLf, ""), vbLf & "|", ""), "|", "") 'Remove start/end linebreak
        rOnLeave.Value = TempValue
    ElseIf Not Intersect(Target, rOnLeave) Is Nothing Then 'You changed the "OnLeave" list
        TempValue = Replace(Replace(rPersonnel.Value, NewValue, ""), vbLf & vbLf, vbLf) 'Remove from Personnel and remove double-linebreaks
        TempValue = Replace(Replace(Replace("|" & TempValue & "|", "|" & vbLf, ""), vbLf & "|", ""), "|", "") 'Remove start/end linebreak
        rPersonnel.Value = TempValue
    End If

    Application.EnableEvents = True
End Sub

推荐阅读