cách đổ dữ liệu vào Combobox (1 người xem)

[thanhtungttvl]

Mình có 2 cái bảng, bảng 1 ở sheet 1 tên là lớp, mình đã dùng hàm thêm mã lớp và tên lớp rồi, bảng thứ 2 bên sheet 2 tên là sinh viên mình định làm là khi mình nhấn vào ô Combobox thì trong đó nó sẽ sổ xuống tất cả danh mục của mã lớp ở bên sheet 1

ai biết đổ dữ liệu vào chĩ mình với
thank

 

[nqdn2010]

Bạn xem thử, có đúng ý không

 

[nqdn2010]

Xin lỗi đọc không kỹ! chắc có lẽ là gì.

 

[Cá ngừ F1]

Mình có 2 cái bảng, bảng 1 ở sheet 1 tên là lớp, mình đã dùng hàm thêm mã lớp và tên lớp rồi, bảng thứ 2 bên sheet 2 tên là sinh viên mình định làm là khi mình nhấn vào ô Combobox thì trong đó nó sẽ sổ xuống tất cả danh mục của mã lớp ở bên sheet 1

ai biết đổ dữ liệu vào chĩ mình với
thank

Tôi thấy bạn gửi Topic này vào Box lập trình:
Copy code này cho vào Module:

Option Explicit
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        tmp = CStr(Item)
        If Len(tmp) Then
          If Not .exists(tmp) Then .Add tmp, ""
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

Copy code này cho vào sheet2 (sheet SinhVien)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Range("A2:A10000"), Target) Is Nothing Then
        Dim arr1, Lop As Range
            Set Lop = Sheet1.Range("A2:A100")
            arr1 = UniqueList(Lop)
        If IsArray(arr1) Then
            With Intersect(Range("A2:A10000"), Target)
            .Validation.Delete
            .Validation.Add 3, , , Join(arr1, ",")
            End With
        End If
    End If
End Sub

 

[Quang_Hải]

Tôi thấy bạn gửi Topic này vào Box lập trình:
Copy code này cho vào Module:

Option Explicit
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        tmp = CStr(Item)
        If Len(tmp) Then
          If Not .exists(tmp) Then .Add tmp, ""
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

Copy code này cho vào sheet2 (sheet SinhVien)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Range("A2:A10000"), Target) Is Nothing Then
        Dim arr1, Lop As Range
            Set Lop = Sheet1.Range("A2:A100")
            arr1 = UniqueList(Lop)
        If IsArray(arr1) Then
            With Intersect(Range("A2:A10000"), Target)
            .Validation.Delete
            .Validation.Add 3, , , Join(arr1, ",")
            End With
        End If
    End If
End Sub

Dùng chi cái búa to quá vậy, chỉ là add DS vào Validation thì hơi quá tay 1 chút.
Thêm thêm cái SendKeys này vào cho nó oai

         With Intersect(Range("A2:A10000"), Target)
            .Validation.Delete
            .Validation.Add 3, , , Join(arr1, ",")
            SendKeys "%{Down}"
        End With

 

[Cá ngừ F1]

Dùng chi cái búa to quá vậy, chỉ là add DS vào Validation thì hơi quá tay 1 chút.
Thêm thêm cái SendKeys này vào cho nó oai

         With Intersect(Range("A2:A10000"), Target)
            .Validation.Delete
            .Validation.Add 3, , , Join(arr1, ",")
            SendKeys "%{Down}"
        End With

A Hải thật là sáng tạo, nhưng mà em chưa hiểu cái SendKeys là cái j đâu, hjk

 

[Cá ngừ F1]

Ố ồ, e hiểu rồi, cho vào code, ko cần click vào cái mũi tên nó cũng xổ ra luôn....