Cách làm Không có ô trống trong: Data Validation...> settings...> list...> Source (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Đặ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

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

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

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

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

N
Khắc phục lỗi "The picture is too large and will be truncated" (1 người xem)
Trả lời
10
Đọc
5K
tle2003
T
C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt (4 người xem)
Trả lời
4
Đọc
133
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
G
Xin Code xóa Module.
Trả lời
8
Đọc
273
huhumalu
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
3
Đọc
148
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
22
Đọc
545
nguyendang95
N
S
Mở 2 cửa sổ riêng biệt (12 người xem)
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
139
lamvu0677
L
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (1 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
1
Đọc
123
khkkh
K
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
798
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
228
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
0
Đọc
148
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
138
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
14
Đọc
224
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
712
thuytrangbp28
T
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
243
Hoàng Tuấn 868
H
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom