Cách làm Không có ô trống trong: Data Validation...> settings...> list...> Source

Liên hệ QC
Đặt validation nhiều nơi bằng cách dùng VBA

ndu96081631 đã viết:
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.
SelectionChange là hành động dùng chuột click chổ này chổ nọ trên bảng tính... vậy tôi chỉ click chơi chơi trên cột A chứ hổng thay đổi dữ liệu gì mà code cũng chạy à? Vô lý
Suy nghĩ xem!
----------
Nếu là tôi thì tôi sẽ viết thế này:
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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 ???
 

File đính kèm

  • Validation.xls
    42.5 KB · Đọc: 31
caico9x đã viết:
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 ???
Nhấp chuột vào đây để mở rộng...

anh NDU chắc là đi hội đàm với anh Bill ùi, mình trả lời cho bạn nha
bạn nhấn phím Alt F11-->chọn sheet1 bạn sẻ thấy đoạn code sau

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cll As Range, Rng As Range
Dim Dic As Object
Set Rng = Sheet1.Range(Sheet1.[A1], Sheet1.[A65000].End(xlUp))
Set Dic = CreateObject("Scripting.Dictionary")
If Not Intersect(Range("A1:A100"), Target) Is Nothing Then
On Error Resume Next
For Each Cll In Rng
If Cll <> "" Then Dic.Add Cll.Value, ""
Next Cll
With Sheet1.[B1].Validation
.Delete
.Add 3, , , Join(Dic.Keys, ",")
.ShowError = False
End With
End If
End Sub

--->đoạn code màu đỏ đó là quy định nơi để validation list tại B1--->vậy muốn làm ở sheet2 chắc bạn biết cách sửa rùi hén.

nhân tiện giới thiệu với bạn thêm một cách làm bằng công thức
đọc cho vui hén..................
 

File đính kèm

  • Copy of Validation.rar
    8 KB · Đọc: 85
nhapmon đã viết:
anh NDU chắc là đi hội đàm với anh Bill ùi, mình trả lời cho bạn nha
bạn nhấn phím Alt F11-->chọn sheet1 bạn sẻ thấy đoạn code sau

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Cll As Range, Rng As Range
Dim Dic As Object
Set Rng = Sheet1.Range(Sheet1.[A1], Sheet1.[A65000].End(xlUp))
Set Dic = CreateObject("Scripting.Dictionary")
If Not Intersect(Range("A1:A100"), Target) Is Nothing Then
On Error Resume Next
For Each Cll In Rng
If Cll <> "" Then Dic.Add Cll.Value, ""
Next Cll
With Sheet1.[B1].Validation
.Delete
.Add 3, , , Join(Dic.Keys, ",")
.ShowError = False
End With
End If
End Sub

--->đoạn code màu đỏ đó là quy định nơi để validation list tại B1--->vậy muốn làm ở sheet2 chắc bạn biết cách sửa rùi hén.

nhân tiện giới thiệu với bạn thêm một cách làm bằng công thức
đọc cho vui hén..................
Nhấp chuột vào đây để mở rộ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
 
Chủ thớt hạn chế dùng nick ảo nhé!
 
caico9x đã viết:
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 ???
Nhấp chuột vào đây để mở rộng...

Code tại sheet2 là:
Mã: 
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 Sub
Chổ màu đỏ là chổ bạn quy định vị trí chứa validation. Ở đây tôi cho code tác dụng từ dòng 1 đến dòng 20 ---> Vậy thay đổi thế nào tùy bạn
---------------------------------------
nhapmon đã viết:
anh NDU chắc là đi hội đàm với anh Bill ùi, mình trả lời cho bạn nha
bạn nhấn phím Alt F11-->chọn sheet1 bạn sẻ thấy đoạn code sau

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'................................
With Sheet1.[B1].Validation
.Delete
.Add 3, , , Join(Dic.Keys, ",")
.ShowError = False
End With
End If
End Sub

--->đoạn code màu đỏ đó là quy định nơi để validation list tại B1--->vậy muốn làm ở sheet2 chắc bạn biết cách sửa rùi hén.
Nhấp chuột vào đây để mở rộng...
Khô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à:
If Not Intersect(Vùng dữ liệu, Target) is nothing then
Trong đó Vùng dữ liệu chính là vị trí bạn đặt validation
--------------------
caico9x đã viết:
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
Nhấp chuột vào đây để mở rộng...
Đâ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
 

File đính kèm

  • Validation.xls
    38.5 KB · Đọc: 101
Lần chỉnh sửa cuối:
ndu96081631 đã viết:
---------------------------------------

Khô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à:
If Not Intersect(Vùng dữ liệu, Target) is nothing then
Trong đó Vùng dữ liệu chính là vị trí bạn đặt validation
--------------------
Nhấp chuột vào đây để mở rộng...


chắc tại hiểu sai ý của đoạn code bài #21,
theo tôi hiểu được là như vậy : là khi di chuyển trong A1:A1000 của sheet1 thì nó sẻ nạp data cho validation list
rồi đặt cái drop list này tại B1
bây giờ muốn để chổ khác thì chỉ cần sửa lại địa chỉ của B1 là xong, và tôi làm đoạn code thay thế đoạn code màu đỏ trên như sau

With Application.Union(Sheet2.[b1:b2], Sheet2.[d1:d20], Sheet2.[f1:f20], Sheet2.[h1:h20], Sheet2.[i1:i20]).Validation
.Delete
.Add 3, , , Join(Dic.Keys, ",")
.Validation.ShowError = False
End With

và thấy nó cũng chạy được, nên mới xúi bạn ấy đó chứ...............hihihì

p/s: ah, đã hiểu rồi, code trong file đính kèm ko phải là đoạn code mà chủ thớt trích dẫn (tôi theo đoạn code trong file)
 
Lần chỉnh sửa cuối:
nhapmon đã viết:
chắc tại hiểu sai ý của đoạn code bài #21,
theo tôi hiểu được là như vậy : là khi di chuyển trong A1:A1000 của sheet1 thì nó sẻ nạp data cho validation list
rồi đặt cái drop list này tại B1
bây giờ muốn để chổ khác thì chỉ cần sửa lại địa chỉ của B1 là xong, và tôi làm đoạn code thay thế đoạn code màu đỏ trên như sau

With Application.Union(Sheet2.[b1:b2], Sheet2.[d1:d20], Sheet2.[f1:f20], Sheet2.[h1:h20], Sheet2.[i1:i20]).Validation
.Delete
.Add 3, , , Join(Dic.Keys, ",")
.Validation.ShowError = False
End With

và thấy nó cũng chạy được, nên mới xúi bạn ấy đó chứ...............hihihì
Nhấp chuột vào đây để mở rộng...
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
Tóm lại:
- Nếu muốn code chạy khi thay đổi vùng A1:A1000 thì phải dùng sự kiện Worksheet_Change
- Nếu muốn code chạy khi chọn vào B1 (cell chứa validation) thì phải dùng sự kiện Worksheet_SelectionChange
Bài 19 tôi đã sửa lại rồi còn gì
 
Cảm ơn các Bác ndu96081631;nhapmon cac bác quá tài quá tài, chúc các bác sức khỏe hạnh phúc
 
ndu96081631 đã viết:
Code tại sheet2 là:
Nhấp chuột vào đây để mở rộng...
Xin phép cho thầy em xin trích dẫn lại code này chút ah
Mã: 
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 Sub
Chổ màu đỏ là chổ bạn quy định vị trí chứa validation. Ở đây tôi cho code tác dụng từ dòng 1 đến dòng 20 ---> Vậy thay đổi thế nào tùy bạn[/QUOTE]
Kính gửi thầy ndu96081631 và các anh chị, trong code ở trên Chổ màu đỏ là chổ quy định vị trí chứa validation chỉ có ở B,D,F,H,J
*nhưng khi sử dụng có vấn đề nảy sinh là số cột chứa validation rất nhiều,
*nên tôi đã viết thêm các cột mầu xanh đậm vào code thì bị lỗi nhưng lại ko biết lỗi gì. Vậy nhờ các anh chị giúp em với ah
Cảm ơn các anh chị
----------
 
Lần chỉnh sửa cuối:
COLACLAC đã viết:
Kính gửi bác ndu và các anh chị, trong Bài #26 ở trên Chổ màu đỏ là chổ quy định vị trí chứa validation chỉ có ở B,D,F,H,J nhưng khi sử dụng có vấn đề nảy sinh là số cột chứa validation rất nhiều, nếu viết tên tát cả các cột vào code thì mất rất nhiều thời gian. Vậy các anh chị có cách nào cải thiện được vấn đề này giúp em với ah
Cảm ơn anh chị
----------
Nhấp chuột vào đây để mở rộng...

Không viết tên cột vào chỗ này cũng phải viết vào chỗ khác, máy tính mà nghe được cũng phải đọc hết cho nó nghe. Ai đó có thể viết 1 đoạn code cho bạn dùng chuột chọn cột, thì cũng phải chọn lần lượt từng ấy cột. Trừ khi tạo ra máy tính có khả năng đọc ý nghĩ, nhưng nghĩ nhầm nó cũng xử lý nhầm như thường.
 
ptm0412 đã viết:
Không viết tên cột vào chỗ này cũng phải viết vào chỗ khác, máy tính mà nghe được cũng phải đọc hết cho nó nghe. Ai đó có thể viết 1 đoạn code cho bạn dùng chuột chọn cột, thì cũng phải chọn lần lượt từng ấy cột. Trừ khi tạo ra máy tính có khả năng đọc ý nghĩ, nhưng nghĩ nhầm nó cũng xử lý nhầm như thường.
Nhấp chuột vào đây để mở rộng...
Bạ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
 
Nhờ các anh chị coi giúp em đoạn code bị lỗi sau khi thêm vùng chứa validation ở #30.
Em cảm ơn các anh chị!
 
mhung12005 đã viết:
Thì bạn phải chuyển Source của Validation sang 1 chỗ khác và bỏ dòng trống đi thì mới được.

Bạn xem file đính kèm nhé.
Nhấp chuột vào đây để mở rộng...

Bạn ơi cho tớ hỏi sao không thấy code của bạn trong file đính kèm nhỉ?
Để mình áp dụng vào file của mình.

Thanks
Khoi
 
KhoiSMC đã viết:
Bạn ơi cho tớ hỏi sao không thấy code của bạn trong file đính kèm nhỉ?
Để mình áp dụng vào file của mình.

Thanks
Khoi
Nhấp chuột vào đây để mở rộng...
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.
 
ndu96081631 đã viết:
Code tại sheet2 là:
Mã: 
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 Sub
Chổ màu đỏ là chổ bạn quy định vị trí chứa validation. Ở đây tôi cho code tác dụng từ dòng 1 đến dòng 20 ---> Vậy thay đổi thế nào tùy bạn
---------------------------------------

Khô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à:
If Not Intersect(Vùng dữ liệu, Target) is nothing then
Trong đó Vùng dữ liệu chính là vị trí bạn đặt validation
--------------------

Đâ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ấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • Validation.xls
    37 KB · Đọc: 14
ndu96081631 đã viết:
Code tại sheet2 là:
Mã: 
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 Sub
Chổ màu đỏ là chổ bạn quy định vị trí chứa validation. Ở đây tôi cho code tác dụng từ dòng 1 đến dòng 20 ---> Vậy thay đổi thế nào tùy bạn
---------------------------------------

Khô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à:
If Not Intersect(Vùng dữ liệu, Target) is nothing then
Trong đó Vùng dữ liệu chính là vị trí bạn đặt validation
--------------------

Đâ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ấp chuột vào đây để mở rộng...
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 ạ.
 
Chào các thầy, em sử dụng cách giống như ndu96081631 nhưng bị lỗi file, không biết có ai đã làm được theo cách này chưa ạ ?
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
2
Đọc
32
phantuancauvan
P
phanmoi688
[Xin nhờ giúp đỡ] Cách đối chiếu dữ liệu giữa hai biểu
    • Thích
2
Trả lời
28
Đọc
386
VetMini
V
tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
19
tby211
tby211
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
6
Đọc
143
NguyenthiH
NguyenthiH
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
508
ngochienbmt
N
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom