Nhờ các bạn giúp mình cách sổ combobox theo danh mục chỉ định.

Liên hệ QC

Phuoctaifast

Thành viên mới
Tham gia
4/7/18
Bài viết
32
Được thích
9
Mình xin chào các bạn trong gruop DPE ạ, mình xin làm phiền các bạn, nhờ các bạn chỉ giúp mình về việc mình muốn tạo combobox sổ danh sách đã có sẵn trong sheet(QLKH),
Theo mình làm như phương pháp thông thường là vào properties - mục Row Source rồi viết Name theo danh sách đã đặt tại sheet (QLKH), nhưng nó sẽ sổ ra những dòng trống và làm nặng file thêm khi nhập vào ạ, rất mong được các bạn chỉ giúp mình về code phần này ạ.
Thanks all
1606453241169.png
 

File đính kèm

  • Xây Dựng Báo Cáo - TCL vina.xlsm
    397.3 KB · Đọc: 28
Mình xin chào các bạn trong gruop DPE ạ, mình xin làm phiền các bạn, nhờ các bạn chỉ giúp mình về việc mình muốn tạo combobox sổ danh sách đã có sẵn trong sheet(QLKH),
Theo mình làm như phương pháp thông thường là vào properties - mục Row Source rồi viết Name theo danh sách đã đặt tại sheet (QLKH), nhưng nó sẽ sổ ra những dòng trống và làm nặng file thêm khi nhập vào ạ, rất mong được các bạn chỉ giúp mình về code phần này ạ.
Thanks all
View attachment 250108
Dùng mảng kết hợp với dictionary có vẻ được.
 
Upvote 0
@Phuoctaifast Bạn tham khảo hàm Uniquelist2D của thầy Ndu
Mã:
Function UniqueList2D(UniqueCol As Long, sArray)
  Dim ReArr()
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                ReDim Preserve ReArr(1 To iCols, 1 To iCount)
                For iCol = 1 To iCols
                   ReArr(iCol, iCount) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = Application.Transpose(ReArr)
  End With
End Function
Code trong form
Mã:
Private Sub UserForm_Initialize()
With Sheet3
    txt_Makh.List = UniqueList2D(1, .Range("C2:C" & .Range("C" & Rows.Count).End(xlUp).Row).Value)
End With
End Sub
 
Upvote 0
Từ từ rồi Phuoctaifast cũng hỏi tới.
trong cái ComboBox
- set MatchEntry to 1 - fmMatchEntryComplete
- set Style to 0 - fmStyleDropDownCombo
 
Upvote 0
@Phuoctaifast Bạn tham khảo hàm Uniquelist2D của thầy Ndu
Mã:
Function UniqueList2D(UniqueCol As Long, sArray)
  Dim ReArr()
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                ReDim Preserve ReArr(1 To iCols, 1 To iCount)
                For iCol = 1 To iCols
                   ReArr(iCol, iCount) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = Application.Transpose(ReArr)
  End With
End Function
Code trong form
Mã:
Private Sub UserForm_Initialize()
With Sheet3
    txt_Makh.List = UniqueList2D(1, .Range("C2:C" & .Range("C" & Rows.Count).End(xlUp).Row).Value)
End With
End Sub
thanks anh rất nhiều ạ
Bài đã được tự động gộp:

Từ từ rồi Phuoctaifast cũng hỏi tới.
trong cái ComboBox
- set MatchEntry to 1 - fmMatchEntryComplete
- set Style to 0 - fmStyleDropDownCombo
hehe, tài chỉ học hỏi thôi
 
Upvote 0
Web KT
Back
Top Bottom