Các Thầy các bác cho hỏi làm sao dùng vba để lấy dữ liệu duy nhất trong data Validation lits

[maiban1986]

em gửi file lên nhờ các bác hướng dẫn xin cảm ơn

 

[ndu96081631]

em gửi file lênh nhờ các bác hướng dẫn xin cảm ơn

Chạy code này thử

Sub CreateValidation()
  Dim arr
  arr = UniqueList(Sheet1.Range("A1:A1000"))
  With Sheet2.Range("A1").Validation
    .Delete
    If IsArray(arr) Then .Add xlValidateList, , , Join(arr, ",")
  End With
End Sub
Function UniqueList(ParamArray sArray())
  Dim item, aTmp, aSub
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each aSub In sArray
      aTmp = aSub
      If Not IsArray(aTmp) Then aTmp = Array(aTmp)
      For Each item In aTmp
        If TypeName(item) <> "Error" Then
          If Len(item) Then
            If Not .Exists(item) Then .Add item, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

 

[levant0908]

Chào Anh/Chị, Excel của Anh/Chị có hàm Unique k ạ. Nếu có thì dùng công thức Unique để đặt tên cho List là xong.

 

[NguyenthiH]

Hàm UNIQUE chỉ mới có ở OFFICE 365 thôi.

 

[maiban1986]

Chạy code này thử

Sub CreateValidation()
  Dim arr
  arr = UniqueList(Sheet1.Range("A1:A1000"))
  With Sheet2.Range("A1").Validation
    .Delete
    If IsArray(arr) Then .Add xlValidateList, , , Join(arr, ",")
  End With
End Sub
Function UniqueList(ParamArray sArray())
  Dim item, aTmp, aSub
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each aSub In sArray
      aTmp = aSub
      If Not IsArray(aTmp) Then aTmp = Array(aTmp)
      For Each item In aTmp
        If TypeName(item) <> "Error" Then
          If Len(item) Then
            If Not .Exists(item) Then .Add item, ""
          End If
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

em cảm ơn Thầy nhiều. Tiện thể Thầy cho em hỏi làm sao thêm dữ liệu nguồn mà nó tự update sheet Validation được ạ. em xin came ơn Thầy

 

[maiban1986]

Chào các Thầy ạ

 

[maiban1986]

Dạ có ai giúp em với ạ

 

[maiban1986]

Helo

 

[maiban1986]

Dạ có ai không xin giúp em với ạ. em xin cảm ơn

 

[concogia]

Dạ có ai không xin giúp em với ạ. em xin cảm ơn

Thử em này xem

 

[maiban1986]

Thử em này xem

Xin cảm ơn anh nhiều. Chúc anh vạn sự thành công

 

[maiban1986]

Thử em này xem

anh cho em hỏi. trong 1 sheet chứa nhiều data validation lits khi lưu lại mở lên nó báo nỗi

 

[maiban1986]

Thử em này xem

chào anh. cái vba nay chuyển sang Module thì làm thế nào mong anh hướng dẫn. em xin cảm ơn

 

[concogia]

chào anh. cái vba nay chuyển sang Module thì làm thế nào mong anh hướng dẫn. em xin cảm ơn

Tại bạn muốn tự động cập nhật nên mình dùng sự kiện Worksheet_Activate, ( ai biết trong Sheet của bạn có cái gì trong đó) chứ muốn cập nhật thì tạo 1 cái nút hoặc tạo phím nóng, bấm một phát là xong thôi mà
Chuyển code sang Module:
Bấm Alt_ F11 ==> Insert ==> Module ==> Tạo 1 Sub ( tên gì tuỳ bạn) chép code đó vào
Thân

 

[maiban1986]

Tại bạn muốn tự động cập nhật nên mình dùng sự kiện Worksheet_Activate, ( ai biết trong Sheet của bạn có cái gì trong đó) chứ muốn cập nhật thì tạo 1 cái nút hoặc tạo phím nóng, bấm một phát là xong thôi mà
Chuyển code sang Module:
Bấm Alt_ F11 ==> Insert ==> Module ==> Tạo 1 Sub ( tên gì tuỳ bạn) chép code đó vào
Thân

anh ơi phải thêm câu lệnh gì nữa thì mới update dữ liệu được ạ. em xin cảm ơn

 

[concogia]

anh ơi phải thêm câu lệnh gì nữa thì mới update dữ liệu được ạ. em xin cảm ơn

Không cần
Thí dụ bạn tạo Sub tên "ToTe" trong file của bài #10 nhé
Public Sub ToTe() Dim Vung, Gom, Dic, I Vung = Sheets("nguon").Range(Sheets("nguon").[A1], Sheets("nguon").[A10000].End(xlUp)) Set Dic = CreateObject("scripting.dictionary") For I = 1 To UBound(Vung) If Not Dic.exists(Vung(I, 1)) Then Dic.Add Vung(I, 1), "" Gom = IIf(Gom = "", Gom & Vung(I, 1), Gom & "," & Vung(I, 1)) End If Next I With Sheets("validation").Range("A1").Validation .Delete .Add xlValidateList, , , Gom End With End Sub
Bạn tạo nút bấm hoặc phím tắt, khi thêm dữ liệu cứ bấm nút hoặc phím tắt là nó cập nhật
( Híc. Lâu quá không gửi bài, quên hết cách gửi)

 

[maiban1986]

Không cần
Thí dụ bạn tạo Sub tên "ToTe" trong file của bài #10 nhé
Public Sub ToTe() Dim Vung, Gom, Dic, I Vung = Sheets("nguon").Range(Sheets("nguon").[A1], Sheets("nguon").[A10000].End(xlUp)) Set Dic = CreateObject("scripting.dictionary") For I = 1 To UBound(Vung) If Not Dic.exists(Vung(I, 1)) Then Dic.Add Vung(I, 1), "" Gom = IIf(Gom = "", Gom & Vung(I, 1), Gom & "," & Vung(I, 1)) End If Next I With Sheets("validation").Range("A1").Validation .Delete .Add xlValidateList, , , Gom End With End Sub
Bạn tạo nút bấm hoặc phím tắt, khi thêm dữ liệu cứ bấm nút hoặc phím tắt là nó cập nhật
( Híc. Lâu quá không gửi bài, quên hết cách gửi)

Có cách nào không cần tạo nút bấm mà nó tự cập nhật không anh. Em xin cảm ơn

 

[concogia]

Có cách nào không cần tạo nút bấm mà nó tự cập nhật không anh. Em xin cảm ơn

Ngoài sự kiện Worksheet_Activate, cũng có thể dùng sự kiện Worksheet_Change tác động vào cột dữ liệu nguồn, code vẫn như cũ
Cái này bạn tìm trên diễn đàn, nhiều lắm
Thân

 

[maiban1986]

Ngoài sự kiện Worksheet_Activate, cũng có thể dùng sự kiện Worksheet_Change tác động vào cột dữ liệu nguồn, code vẫn như cũ
Cái này bạn tìm trên diễn đàn, nhiều lắm
Thân

Dạ xin cảm ơn anh đã giúp đỡ