Hàm VBA Worksheet_Change cho excel

Tôi đã sửa đổi chức năng chủ đề để loại bỏ các lựa chọn hiện có khi chọn lại chúng và loại bỏ các lựa chọn bổ sung. Đây là mã đã sửa đổi:

Private Sub Worksheet_Change (ByVal Target As Range)
'Cập nhật Extendoffice 2019/11/13
'Cập nhật bởi Ken Gardner 2022/07/11
Dim xRng theo phạm vi
Dim xValue1 dưới dạng Chuỗi
Dim xValue2 dưới dạng Chuỗi
Dim semiColonCnt dưới dạng số nguyên
If Target.Count> 1 Then Exit Sub
On Error Resume Next
Đặt xRng = Cells.SpecialCells (xlCellTypeAllValidation)
Nếu xRng Không Có Gì Thì Thoát Sub
Application.EnableEvents = Sai
'If Not Application.Intersect (Target, xRng) Is nothing then
If Application.Intersect (Target, xRng) Sau đó
xValue2 = Mục tiêu.Giá trị
Ứng dụng.Hoàn tác
xValue1 = Mục tiêu.Giá trị
Mục tiêu.Value = xValue2
Nếu xValue1 <> "" Thì
Nếu xValue2 <> "" Thì
Nếu xValue1 = xValue2 Hoặc xValue1 = xValue2 & ";" Hoặc xValue1 = xValue2 & ";" Sau đó 'để lại giá trị nếu chỉ có một trong danh sách
xValue1 = Replace (xValue1, ";", "")
xValue1 = Replace (xValue1, ";", "")
Mục tiêu.Value = xValue1
ElseIf InStr (1, xValue1, ";" & xValue2) Sau đó
xValue1 = Replace (xValue1, xValue2, "") 'xóa giá trị hiện có khỏi danh sách khi lựa chọn lặp lại
Mục tiêu.Value = xValue1
ElseIf InStr (1, xValue1, xValue2 & ";") thì
xValue1 = Thay thế (xValue1, xValue2, "")
Mục tiêu.Value = xValue1
Khác
Target.Value = xValue1 & ";" & xValue2
Cuối Nếu
Target.Value = Replace (Target.Value, ";;", ";")
Target.Value = Replace (Target.Value, ";;", ";")
If InStr (1, Target.Value, ";") = 1 Then 'kiểm tra; là ký tự đầu tiên và xóa nó
Target.Value = Replace (Target.Value, ";", "", 1, 1)
Cuối Nếu
Nếu InStr (1, Target.Value, ";") = 1 Thì
Target.Value = Replace (Target.Value, ";", "", 1, 1)
Cuối Nếu
dấu chấm phẩyCnt = 0
For i = 1 To Len (Target.Value)
Nếu InStr (i, Target.Value, ";") thì
SemiColonCnt = SemiColonCnt + 1
Cuối Nếu
Tiếp theo
Nếu semiColonCnt = 1 Then 'remove; nếu ký tự cuối cùng
Target.Value = Replace (Target.Value, ";", "")
Target.Value = Replace (Target.Value, ";", "")
Cuối Nếu
Cuối Nếu
Cuối Nếu
Cuối Nếu
Ứng dụng.EnableEvents = True
End Sub