Làm cách nào để ngăn sao chép và dán qua ô với danh sách thả xuống trong Excel?

Đối với ô có danh sách sổ xuống xác thực dữ liệu, khi sao chép nội dung từ ô khác và dán vào ô đó, danh sách thả xuống sẽ biến mất và được thay thế bằng nội dung dán mới. Trong một số trường hợp, bạn muốn ngăn việc sao chép và dán nội dung khác lên ô bằng danh sách thả xuống, bạn sẽ làm gì để giải quyết? Trong bài viết này, bạn sẽ nhận được một phương pháp VBA để giải quyết vấn đề này.

Ngăn sao chép và dán qua ô với danh sách thả xuống trong Excel

Ngăn sao chép và dán qua ô với danh sách thả xuống trong Excel

1. Mở trang tính với ô danh sách thả xuống mà bạn muốn ngăn sao chép và dán.

2. nhấn Khác + F11 các phím đồng thời để mở Ứng dụng Microsoft Visual Basic cửa sổ.

3. bên trong Ứng dụng Microsoft Visual Basic , bấm đúp vào tên trang tính hiện tại trong ngăn bên trái, sau đó sao chép và dán mã VBA bên dưới vào Trình chỉnh sửa mã. Xem ảnh chụp màn hình:

Mã VBA: Ngăn sao chép và dán qua ô với danh sách thả xuống

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20200903
    Dim xValue As String
    Dim xCheck1 As String
    Dim xCheck2 As String
    Dim xRg As Range
    Dim xArrCheck1() As String
    Dim xArrCheck2() As String
    Dim xArrValue()
    Dim xCount, xJ As Integer
    Dim xBol As Boolean
'    If Target.Count > 1 Then
'        Exit Sub
'        End If
    xCount = Target.Count
    ReDim xArrCheck1(1 To xCount)
    ReDim xArrCheck2(1 To xCount)
    ReDim xArrValue(1 To xCount)
    Application.EnableEvents = False
    On Error Resume Next
    xJ = 1
    For Each xRg In Target
        xArrValue(xJ) = xRg.Value
         xArrCheck1(xJ) = xRg.Validation.InCellDropdown
        xJ = xJ + 1
    Next

    Application.Undo

    xJ = 1
    For Each xRg In Target
        xArrCheck2(xJ) = xRg.Validation.InCellDropdown
        xJ = xJ + 1
    Next

    xBol = False
    For xJ = 1 To xCount
        If xArrCheck2(xJ) <> xArrCheck1(xJ) Then
            xBol = True
            Exit For
        End If
    Next

    If xBol Then
       MsgBox "The selected cells containg data validation drop-down lists, no pasting allowed."
    Else
        xJ = 1
        For Each xRg In Target
            xRg.Value = xArrValue(xJ)
            xJ = xJ + 1
        Next

    End If

    Application.EnableEvents = True
End Sub

4. nhấn Khác + Q chìa khóa để thoát khỏi Ứng dụng Microsoft Visual Basic cửa sổ.

5. Khi bạn dán nội dung vào một ô có danh sách thả xuống, một hộp thoại sẽ bật lên để nhắc nhở bạn không được phép dán. Xem ảnh chụp màn hình:

Chú thích: VBA này chỉ hoạt động trong dán ô đơn. Nếu bạn sao chép và dán vào nhiều ô, nó sẽ không hoạt động.

Các bài liên quan: