VBA Excel - изменение текста в одной ячейке изменяет текст в другой. Проверка данных

Question

Я искал ответ на эту проблему.

У меня есть лист с тремя ячейками, которые управляются проверкой данных, ячейка содержит имена сотрудников.

Заголовки ячеек:

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

Я бы хотел обновить эту ячейку, так как пользователь заполняет ячейку «Персонал и на выходе», используя раскрывающийся список (Проверка данных)

Другими словами, если пользователь заполняет ячейку «Персонал» именем сотрудника с помощью раскрывающегося списка «Проверка данных», то «Нераспределенная» ячейка удаляет это имя из ячейки, это также будет работать для ячейки «При выходе».

Любая помощь будет принята с благодарностью.

Код, который я использую для проверки данных:

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

Answer 1

Первый совет: вместо 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