Sử dụng 2 combobox trong 1 sheet (2 người xem)

[quynhnamimex]

Xin chào các bạn

Mình đang tập làm VBA trên excel nên gặp nhiều thắc mắc.

Mình muốn sử dụng 2 combobox trong 1 sheet nhưng mình chỉ gọi được 1 combobox thôi, nhờ các bạn giúp dùm làm thế nào để sử dụng được cả 2 luôn, trong file mình gửi sử dụng 2 combobox trên cột màu vàng trong sheet nhaplieu

Cám ơn các bạn nhiều

 

[Let'GâuGâu]

Xin chào các bạn

Mình đang tập làm VBA trên excel nên gặp nhiều thắc mắc.

Mình muốn sử dụng 2 combobox trong 1 sheet nhưng mình chỉ gọi được 1 combobox thôi, nhờ các bạn giúp dùm làm thế nào để sử dụng được cả 2 luôn, trong file mình gửi sử dụng 2 combobox trên cột màu vàng trong sheet nhaplieu

Cám ơn các bạn nhiều

trong một sự kiện bạn cho bao nhiêu cái if cũng được,nhưng bạn ko thể làm cùng sự kiện 2 lần trong một sheet
ví dụ
code của bạn là

if target.column=2 then
...........gọi cobobox1
end if
if target.column=5 then
..............goi cobobox2
end if

tuy nhiên, ko cần thiết phải làm 2 cobobox trong trường hợp này.
bạn giử lại cái cobox1 xoá cái thừ 2 đi
code trong work sheet chage sửa lại như sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 1 Then
        If Target.Column = 2 Or Target.Column = 5 Then
            Call Thaydoi1
            Call MKH
        Else
            Call Hide1
        End If
    End If

End Sub

code goi cobobox sửa lại như sau:

Sub MKH()
With Sheet3.CBoBox1
If ActiveCell.Column = 5 Then .ListFillRange = "MaHH"              ' Lay List cua CB la Name KhachHang
If ActiveCell.Column = 2 Then .ListFillRange = "MaKH"              ' Lay List cua CB la Name KhachHang
        .LinkedCell = ActiveCell.Address    ' Lay o CB link toi la o chon
        .Activate                           ' Kinh hoat CB
    End With
    SendKeys ("%{DOWN}")                    ' Nhan to hop phim Alt + mui ten xuong
End Sub

======
bạn hãy tìm hiểu thêm cách nạp list cho combobox, tránh sửa dụng listfillrange, xài thằng này rắc rối lắm

 

[boydaigai]

Bài này e làm như sau :

Private Sub napkh()
Dim arr(), i
arr = Sheet1.Range("B2" & Sheet1.Range("A65000").End(3).Row).Value
With Sheet3.ComboBox1
.ColumnCount = 3
.ColumnWidths = "40 pt;80 pt;150 pt"
.ListWidth = "270 pt"
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then
.AddItem arr(i, 1)
.List(.ListCount - 1, 1) = arr(i, 2)
.List(.ListCount - 1, 2) = arr(i, 3)
End If
Next i
End With
Erase arr()
End Sub

Private Sub ComboBox1_Change()
With ActiveCell
.Value = ComboBox1.Column(1).Value
.Offset(, 1).Value = ComboBox1.Column(2).Value
.Offset(, 2).Value = ComboBox1.Column(3).Value
End With
End Sub

Private Sub Worksheet_Activate()
ComboBox1.Clear
napkh
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If .Column = 2 And .Row > 2 Then
ComboBox1.Visible = True
ComboBox1.Top = ActiveCell.Top
ComboBox1.Left = ActiveCell.Left
ComboBox1.Width = ActiveCell.Width
Else
ComboBox1.Visible = False
End If
End With
End Sub

Viết kiểu này chắc phải dùng 2 combobox, dùng list mà chỉ dùng 1 combobox thì viết kiểu j đc nhỉ

 

[Let'GâuGâu]

Viết kiểu này chắc phải dùng 2 combobox, dùng list mà chỉ dùng 1 combobox thì viết kiểu j đc nhỉ

đại khái là vậy
code cho work sheet change

Private Sub CBoBox1_Change()
On Error GoTo thoat
With Sheet3.CBoBox1
If .Value <> "" Then
    ActiveCell = .Value
    ActiveCell.Offset(0, 1).Value = .Column(1) ' O ben canh lay gia tri o cot thu 2
    ActiveCell.Offset(0, 2).Value = .Column(2) ' O ben canh lay gia tri o cot thu 3
End If
End With
thoat:  Exit Sub
End Sub
Private Sub CBoBox1_DropButtonClick()
naplist
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 1 Then
        If Target.Column = 2 Or Target.Column = 5 Then
            Call Thaydoi1
            
        Else
            Call Hide1
        End If
    End If

End Sub

code cho module

Sub Hide1()
With Sheet3.CBoBox1
        .Visible = False                     ' Khong cho hien thi CB
    End With
End Sub
Sub Thaydoi1()
With Sheet3.CBoBox1
        .Visible = False            ' Khong cho hien thi CB
        .Visible = True             ' Cho hien thi CB
        .Left = ActiveCell.Left     ' Lam cho CB vua voi o chon
        .Top = ActiveCell.Top       ' Lam cho CB vua voi o chon
        .Width = ActiveCell.Width   ' Lam cho CB vua voi o chon
        .Height = ActiveCell.Height ' Lam cho CB vua voi o chon
        .Value = ""                 ' Cho gia tri  CB = 0 de CB_Change khong chay
End With
End Sub


Sub naplist()
Dim arr As Variant
Sheet3.CBoBox1.Clear

If ActiveCell.Column = 5 Then
    With Sheet2
        arr = .[b2].Resize(.[b60000].End(3).Row, 3).Value
    End With
    For i = 1 To UBound(arr)
    With Sheet3.CBoBox1
    If arr(i, 1) <> "" Then
        .AddItem arr(i, 1)
        .List(.ListCount - 1, 1) = arr(i, 2)
        .List(.ListCount - 1, 2) = arr(i, 3)
    End If
    End With
    Next
End If

If ActiveCell.Column = 2 Then
    With Sheet1
        arr = .[b2].Resize(.[b60000].End(3).Row, 3).Value
    End With
    For i = 1 To UBound(arr)
    With Sheet3.CBoBox1
    If arr(i, 1) <> "" Then
        .AddItem arr(i, 1)
        .List(.ListCount - 1, 1) = arr(i, 2)
        .List(.ListCount - 1, 2) = arr(i, 3)
    End If
    End With
    Next
End If
    'SendKeys ("%{DOWN}")                    ' Nhan to hop phim Alt + mui ten xuong
    Erase arr
End Sub

 

[Quang_Hải]

đại khái là vậy
code cho work sheet change

Private Sub CBoBox1_Change()
On Error GoTo thoat
With Sheet3.CBoBox1
If .Value <> "" Then
    ActiveCell = .Value
    ActiveCell.Offset(0, 1).Value = .Column(1) ' O ben canh lay gia tri o cot thu 2
    ActiveCell.Offset(0, 2).Value = .Column(2) ' O ben canh lay gia tri o cot thu 3
End If
End With
thoat:  Exit Sub
End Sub
Private Sub CBoBox1_DropButtonClick()
naplist
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row > 1 Then
        If Target.Column = 2 Or Target.Column = 5 Then
            Call Thaydoi1
            
        Else
            Call Hide1
        End If
    End If

End Sub

code cho module

Sub Hide1()
With Sheet3.CBoBox1
        .Visible = False                     ' Khong cho hien thi CB
    End With
End Sub
Sub Thaydoi1()
With Sheet3.CBoBox1
        .Visible = False            ' Khong cho hien thi CB
        .Visible = True             ' Cho hien thi CB
        .Left = ActiveCell.Left     ' Lam cho CB vua voi o chon
        .Top = ActiveCell.Top       ' Lam cho CB vua voi o chon
        .Width = ActiveCell.Width   ' Lam cho CB vua voi o chon
        .Height = ActiveCell.Height ' Lam cho CB vua voi o chon
        .Value = ""                 ' Cho gia tri  CB = 0 de CB_Change khong chay
End With
End Sub


Sub naplist()
Dim arr As Variant
Sheet3.CBoBox1.Clear

If ActiveCell.Column = 5 Then
    With Sheet2
        arr = .[b2].Resize(.[b60000].End(3).Row, 3).Value
    End With
    For i = 1 To UBound(arr)
    With Sheet3.CBoBox1
    If arr(i, 1) <> "" Then
        .AddItem arr(i, 1)
        .List(.ListCount - 1, 1) = arr(i, 2)
        .List(.ListCount - 1, 2) = arr(i, 3)
    End If
    End With
    Next
End If

If ActiveCell.Column = 2 Then
    With Sheet1
        arr = .[b2].Resize(.[b60000].End(3).Row, 3).Value
    End With
    For i = 1 To UBound(arr)
    With Sheet3.CBoBox1
    If arr(i, 1) <> "" Then
        .AddItem arr(i, 1)
        .List(.ListCount - 1, 1) = arr(i, 2)
        .List(.ListCount - 1, 2) = arr(i, 3)
    End If
    End With
    Next
End If
    'SendKeys ("%{DOWN}")                    ' Nhan to hop phim Alt + mui ten xuong
    Erase arr
End Sub

Nếu dữ liệu ít thì nạp theo kiểu additem còn chấp nhận được, chứ dữ liệu nhiều nạp kiểu này lâu lắm. Thà nạp vào mảng rồi chạy thêm 1 vòng lặp nữa để không bị cái khoảng trống phía dưới nhưng vẫn nhanh hơn kiểu additem. Mình đã từng bị rồi.

 

[boydaigai]

Như Chú Quanghai1969 nói
Code của a gâu tuy tiện dụng nhưng E thử với hai cái danh mục mỗi cái 5000 dòng. Trên máy e thì code của a gâu bị đơ

Làm theo kiểu worksheet active của e thì không sao vì nó nạp list có đúng 1 lần rồi cứ thế mà dùng nhưng bị lỗi chọn một ô trong vùng trọng copy rồi paste , hoặc chọn 1 ô rồi kéo giá trị xuống cũng không được luôn. search diễn đàn thấy cái application.cutcopymode thì xử đc bug này nhưng lòi ra bug khác là không undo được nếu thay đổi giá trị bằng combobox.

Túm lại có vẻ cái textbox + listbox vẫn tiện dụng hơn

 

[Quang_Hải]

Code nạp list viết theo dạng này sẽ gọn hơn. Tuy nhiên nên tạo thêm 1 mảng và 1 vòng lặp nữa để loại bỏ dòng trống.

Sub naplist()
Dim shname As String, Arr(), i&, Temp(), j&, k
shname = IIf(ActiveCell.Column = 2, "HangHoa", "KhachHang")
With Sheets(shname)
   Arr = .Range("B2", .[D65536].End(3)).Value
   ReDim Temp(1 To UBound(Arr), 1 To 3)
End With
For i = 1 To UBound(Arr)
   If Arr(i, 1) <> "" Then
      k = k + 1
      For j = 1 To 3
         Temp(k, j) = Arr(i, j)
      Next
   End If
Next
Sheet3.CBoBox1.List = Temp
End Sub

 

[Let'GâuGâu]

Code nạp list viết theo dạng này sẽ gọn hơn. Tuy nhiên nên tạo thêm 1 mảng và 1 vòng lặp nữa để loại bỏ dòng trống.

Sub naplist()
Dim shname As String, Arr(), i&, Temp(), j&, k
shname = IIf(ActiveCell.Column = 2, "HangHoa", "KhachHang")
With Sheets(shname)
   Arr = .Range("B2", .[D65536].End(3)).Value
   ReDim Temp(1 To UBound(Arr), 1 To 3)
End With
For i = 1 To UBound(Arr)
   If Arr(i, 1) <> "" Then
      k = k + 1
      For j = 1 To 3
         Temp(k, j) = Arr(i, j)
      Next
   End If
Next
Sheet3.CBoBox1.List = Temp
End Sub

ủa sao hôm qua tôi cũng nạp kiểu này nó ko vô, hôm nay lại được???
anh xem thử nạp như vậy có được không

Sub naplist()
Sheet3.CBoBox1.Clear

If ActiveCell.Column = 5 Then Sheet3.CBoBox1.List = Sheet2.[b2].Resize(Sheet2.[b6000].End(3).Row, 3).Value

If ActiveCell.Column = 2 Then Sheet3.CBoBox1.List = Sheet1.[b2].Resize(Sheet1.[b6000].End(3).Row, 3).Value
    
End Sub

 

[Quang_Hải]

ủa sao hôm qua tôi cũng nạp kiểu này nó ko vô, hôm nay lại được???
anh xem thử nạp như vậy có được không

Sub naplist()
Sheet3.CBoBox1.Clear

If ActiveCell.Column = 5 Then Sheet3.CBoBox1.List = Sheet2.[b2].Resize(Sheet2.[b6000].End(3).Row, 3).Value

If ActiveCell.Column = 2 Then Sheet3.CBoBox1.List = Sheet1.[b2].Resize(Sheet1.[b6000].End(3).Row, 3).Value
    
End Sub

Thuộc tính .List cho phép nạp từ range nữa mà.
Mà chắc không cần clear vì mỗi lần nạp là dữ liệu cũ bị mất mà

 

[boydaigai]

e Thử với cái 5000 dòng code của 2 đại ca chạy ok thật
2 đại ca xử nốt cái undo , hoàn thiện cái combo này cho nó mát luôn thể

 

[Quang_Hải]

e Thử với cái 5000 dòng code của 2 đại ca chạy ok thật
2 đại ca xử nốt cái undo , hoàn thiện cái combo này cho nó mát luôn thể

Undo là làm gì? Mà khi đã xài code thì nên quên đi mấy khái niệm Undo.

 

[boydaigai]

Ý e là giả sử hàng thứ 2 đang là KH01, nguyen nam , AAA
hàng 3,4,5 ta sắp điền cũng là KH01, nguyennam , AAA thì thay vì click combo chọn từng cái 1 thì ta quét khối 3 ô hàng thứ 2 rồi kéo xuống cho tiện chứ. Chả may lỡ tay kéo nhầm xuống hàng 6 hàng 7 thì không undo đc.

 

[Let'GâuGâu]

Ý e là giả sử hàng thứ 2 đang là KH01, nguyen nam , AAA
hàng 3,4,5 ta sắp điền cũng là KH01, nguyennam , AAA thì thay vì click combo chọn từng cái 1 thì ta quét khối 3 ô hàng thứ 2 rồi kéo xuống cho tiện chứ. Chả may lỡ tay kéo nhầm xuống hàng 6 hàng 7 thì không undo đc.

code cho worksheet change
bạn thêm điều kiện target.count=1 tức là nếu chọn 1 ô thì code chạy, nhiều cell thì nó ko chạy........chắc là vậy....hihihihiiii