Danh sách ở cột A1:A7 là cố định không thể xóa được 2 ô trống đó
Không xóa được trong source thì phải dùng source khác, và source đó không trống.
Ý bạn là dùng source phụ, nhưng làm sao source phụ tự động thay đổi theo khi sỏuce chính thay đổi
Cảm ơn bạn, đã giúp tôi xử lí được 50%về trường hợp ô trống. Còn trường hợp trung ô trùng nhau bạn có cách nào ko, xin giúp đỡ
Vâng ah, vậy ndu906081631 giúp tôi VBA như vậy nhé
Cảm ơn bạn, bạn giúp đỡ như vậy là ổn rồi, nhưng sợ file nặng thêm như bác ndu phân tích
Cho em mượn tạm cái Valilist của anh mhung12005 nhé, bạn dùng công thức này cho H2 rùi làm List để chọn cũng được, hơi dài chút nhưng cũng là 1 cách.
=IF(ISERROR(INDEX(Valilist,MATCH(1,INDEX((Valilist<>"")*(COUNTIF($H$1:H1,Valilist)=0),0),0))),"",INDEX(Valilist,MATCH(1,INDEX((Valilist<>"")*(COUNTIF($H$1:H1,Valilist)=0),0),0)))Quá chuẩn luôn, cảm ơn mhung12005 và các bạn cùng giúp
Cái này bạn giỡn chơi với thichthibup hay sao ah, thêm vào cột A nó lặng thinh mà
If Not Intersect(Range("A1:A100"), Target) Is Nothing ThenKhông hiểu sao file này khi mở lên ko hề có đoạn code nào, nhờ các bác kiểm tra giúp; hơn nữa các file trước đây có code nhưng nay mở ra thì không thấy dòng code nào, mặc dù phai đó vẫn hoạt động bình thường
Em đang hiểu ý của anh mhung12005 là khi chọn và thêm dữ liệu vào vùng [A1:A100] code chạy luôn và cập nhật vào validation sư phụ ạ, hành động thêm dữ liệu trước, cũng hơi ngược ngược chút vì có phải lúc nào cũng thêm dữ liệu đâu mà tác động vào vùng A1:A100. hix! Có lẽ là anh ấy đang triển khai code theo hướng đó nên mới viết như vậy.
Nếu chọn hành động THÊM DỮ LIỆU thì cập nhật code. Vậy ta phải dùng sự kiện Change chứ sao lại SelectionChange.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim arr, Item, dic As Object, tmp As String
On Error Resume Next
If Target.Address = "$B$1" Then
arr = Range("A1:A10000").Value
Set dic = CreateObject("Scripting.Dictionary")
For Each Item In arr
tmp = CStr(Item)
If Len(tmp) Then
If Not dic.Exists(tmp) Then dic.Add tmp, ""
End If
Next
With Target.Validation
.Delete
If dic.Count Then .Add 3, , , Join(dic.Keys, ",")
End With
End If
End Sub
Chào thầy ndu96081631, em muốn đăt validation tại nhiều ô như :Tại sheet2 em muốn đặt Validation vào các cột B;D;F;H;J với kết quả giống như ở Ô (B1) sheet1;THÌ CÓ CÁC NÀO LÀM KHÔNG ???
Cảm ơn bạn, nhưng tôi vẫn chưa biết cách: sau khi copy code vào rồi, làm sao cho code chạy tại ô B1 ah
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim arr, Item, dic As Object, tmp As String
On Error Resume Next
If Not Intersect(Union([B][COLOR=#ff0000][B1:B20], [D1:D20], [F1:F20], [H1:H20], [J1:J20][/COLOR][/B]), Target) Is Nothing Then
If Target.Count = 1 Then
arr = Sheet1.Range("A1:A10000").Value
Set dic = CreateObject("Scripting.Dictionary")
For Each Item In arr
tmp = CStr(Item)
If Len(tmp) Then
If Not dic.Exists(tmp) Then dic.Add tmp, ""
End If
Next
With Target.Validation
.Delete
If dic.Count Then .Add 3, , , Join(dic.Keys, ",")
End With
End If
End If
End SubKhông đơn giản vậy đâu. Vì điều đầu tiên là phải giới hạn Target thuộc vùng nào (để khi chọn vào đó thì code mới chạy)... Vây nên câu lệnh bắt buộc đầu tiên phải là:
Đây là code SỰ KIỆN, thành ra bạn khỏi cần phải làm gì cả (đương nhiên phải Enable Macros) chi cần đặt chuột vào vùng ta định sẵn (như trong file của tôi là vùng màu vàng) thì code tự động chạy
Như tôi đã đề cập từ mấy bài trước thì code mà bạn vừa nói đang dùng sai sự kiện nên dù có chạy được nhưng chưa tối ưu
Xin phép cho thầy em xin trích dẫn lại code này chút ah
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim arr, Item, dic As Object, tmp As String
On Error Resume Next
If Not Intersect(Union([COLOR=#ff0000][B][B1:B60], [D1:D60], [F1:F60], [H1:H60], [J1:J60][/B][/COLOR],[COLOR=#0000cd] [B][L1:L60], [N1:N60], [P1:P60], [R1:R60], [T1:T60], [V1:V60], [X1:X60], [Z1:Z60], [AB1:AB60], [AD1:AD60], [AF1:AF60], [AH1:AH60], [AJ1:AJ60], [AL1:AL60], [AN1:AN60], [AP1:AP60], [AR1:AR60], [AT1:AT60], [AV1:AV60], [AX1:AX60], [AZ1:AZ60], [BB1:BB60], [BD1:BD60], [BF1:BF60], [BH1:BH60], [BJ1:BJ60], [BL1:BL60], [BN1:BN60], [BP1:BP60], [BR1:BR60], [BT1:BT60][/B][/COLOR]), Target) Is Nothing Then
If Target.Count = 1 Then
arr = Sheet1.Range("A1:A10000").Value
Set dic = CreateObject("Scripting.Dictionary")
For Each Item In arr
tmp = CStr(Item)
If Len(tmp) Then
If Not dic.Exists(tmp) Then dic.Add tmp, ""
End If
Next
With Target.Validation
.Delete
If dic.Count Then .Add 3, , , Join(dic.Keys, ",")
End With
End If
End If
End SubBạn nói đúng rồi, nhưng tôi nghĩ là có giải pháp nào không thôi mà??? Cảm ơn ptm có lẽ tôi lại nhiều chuyện rùi
Bạn nhấn Ctrl+F3 và nghiên cứu mấy cái Name trong đó chứ file này có dùng code chi đâu mà bạn thấy được.
Thầy cho em hỏi như code của thày thì em đã áp dung cho 1 vùng dữ liệu để ra nhiều vùng chưa Valadation, nay em muốn làm sao để cho mõi vùng nguồn dữ liệu, sẽ cho ra 1 vùng chứa Valadation. nếu vậy thì phải chỉnh code lại như thế nào, nhờ thầy giúp
thầy cho em hỏi nếu chỉ muốn dùng 1 ô chưa validation ở sheet 2 thì phải sửa lại code như nào ạ.
