Chọn 1 lần được nhiều mã trong list

Liên hệ QC

0905744404

Thành viên thường trực
Tham gia
26/10/10
Bài viết
333
Được thích
107
Nghề nghiệp
Trước là : Thủ Kho - còn giờ thì :"Tài Xế"
Chào cả nhà!
Em có file đính kèm, nhờ mọi người viết thêm code VBA sao để có thể chọn 1 lần được nhiều mã hàng thỏa mãn tên tìm kiếm trong list
( Code này do anh Hoàng Trọng Nghĩa Đã Viết giúp em lúc trước)
VD: KM Nước thì chọn được nhiều mã hàng thỏa mãn
 

File đính kèm

  • List Ma HH Chon Nhieu Ma.xlsm
    237.6 KB · Đọc: 78
  • Chon Nhieu Ma Trong List.jpg
    Chon Nhieu Ma Trong List.jpg
    23.2 KB · Đọc: 53
Lần chỉnh sửa cuối:
Đã khá lâu rồi mà không thấy hồi âm ...
Mong mọi người giúp đỡ với
 
Upvote 0
Upvote 0
Upvote 0
Bạn mnói rõ hơn, mình không tìm thấy Multiselect trong listbox

Mới coi file trên của a Nghĩa. File trên đó ảnh dùng Combobox nên bạn không thể tìm Multiselect là đúng. Giải pháp của a Hai Lúa là bạn có thể thay combobox bên trên thành listbox nhưng lúc đó code bên trong sẽ đổi !
 
Upvote 0
Chào cả nhà!
Em có file đính kèm, nhờ mọi người viết thêm code VBA sao để có thể chọn 1 lần được nhiều mã hàng thỏa mãn tên tìm kiếm trong list
( Code này do anh Hoàng Trọng Nghĩa Đã Viết giúp em lúc trước)
VD: KM Nước thì chọn được nhiều mã hàng thỏa mãn
MÔ TẢ CÔNG VIỆC:

Trên sheet 'Xuat Kho', bấm nút 'NHAP DU LIEU' để UserForm 'usfTimKiem' xuất hiện.

Trên Form có:

2 TextBox: Tìm theo mã hàng Tìm theo tên hàng.

1 ListBox: Danh sách các mặt hàng (bao gồm ID, Tên, Đơn giá). Nó sẽ hiển thị kết quả tìm kiếm dựa trên các TextBox nói trên.

4 CommandButton: Đánh dấu tất cả, Hủy đánh dấu tất cả, Nhập đánh dấu, Thoát Form.

- Khi tìm kiếm theo mã hay tên hàng, bạn gõ vào các 1 trong 2 TextBox, phần lọc ra sẽ hiển thị trên ListBox.

- Click chuột vào mục nào (hàng nào) bạn cần đánh dấu trên ListBox. Sau khi được đánh dấu thì nút Nhập đánh dấu sẽ được khả dụng, ngược lại, nếu không có mục nào được đánh dấu thì nút này sẽ không khả dụng.

- Bạn cũng có thể chọn tất cả các hàng bằng cách bấm vào nút Đánh dấu tất cả, ngược lại bạn cũng có thể bấm vào nút Hủy đánh dấu tất cả.

- Bấm vào nút Nhập đánh dấu để nhập tất cả các mục đã được đánh dấu xuống sheet.

CÁC CODE TRONG USERFORM:

Khởi động Form:

Mã:
Private Sub UserForm_Initialize()
    Dim LastRow As Long
    Dim shBangMa As Worksheet
    
    Set shBangMa = Sheets("Bang Ma Hang Hoa")
    LastRow = shBangMa.Range("B" & Rows.Count).End(xlUp).Row
    
    priArrList = shBangMa.Range("B2:E" & LastRow)
    priUBound = UBound(priArrList)
    
    lbxDanhMuc.List = priArrList
End Sub

Thủ tục tìm kiếm theo Mã hàng hoặc theo Tên hàng:

Mã:
Private Sub KeyFind(ByVal FindText As String, ByVal Column As Byte)
    
    cmdNhap.Enabled = False
    
    Dim c As Byte
    Dim StrItem As String
    Dim n As Long, r As Long
    Dim GetRows(), ArrFilter()
    
    StrItem = "*" & UCase(FindText) & "*"
    
    For r = 1 To priUBound
        If UCase(priArrList(r, Column)) Like StrItem Then
            n = n + 1
            ReDim Preserve GetRows(1 To n)
            GetRows(n) = r
        End If
    Next
    
    If n > 0 Then
        ReDim ArrFilter(1 To n, 1 To 4)
        For c = 1 To 4
            For r = 1 To n
                ArrFilter(r, c) = priArrList(GetRows(r), c)
            Next
        Next
        lbxDanhMuc.List = ArrFilter
    Else
        lbxDanhMuc.Clear
    End If
End Sub

Sự kiện tên các TextBox:

Mã:
Private Sub tbxMaHang_Enter()
    priCheck = False
End Sub

Private Sub tbxMaHang_Change()
    If priCheck Then Exit Sub
    If tbxTenHang > "" Then tbxTenHang = ""
    KeyFind tbxMaHang, 1
End Sub

Private Sub tbxTenHang_Enter()
    priCheck = True
End Sub

Private Sub tbxTenHang_Change()
    If Not priCheck Then Exit Sub
    If tbxMaHang > "" Then tbxMaHang = ""
    KeyFind tbxTenHang, 2
End Sub

Sự kiện để đánh dấu trên ListBox:

Mã:
Private Sub lbxDanhMuc_Change()
    Dim Idx As Long
    For Idx = 0 To lbxDanhMuc.ListCount - 1
        If lbxDanhMuc.Selected(Idx) = True Then
            cmdNhap.Enabled = True
            Exit Sub
        End If
    Next
    If Idx = lbxDanhMuc.ListCount Then
        cmdNhap.Enabled = False
    End If
End Sub

Nhập xuống sheet dữ liệu đã được đánh dấu:

Mã:
Private Sub cmdNhap_Click()
    Dim c As Byte
    Dim shXuatKho As Worksheet
    Dim Idx As Long, LastRow As Long
    
    Set shXuatKho = Sheets("Xuat Kho")
    LastRow = shXuatKho.Range("F" & Rows.Count).End(xlUp).Row
    
    With lbxDanhMuc
        For Idx = 0 To .ListCount - 1
            If .Selected(Idx) = True Then
                LastRow = LastRow + 1
                For c = 0 To 2
                    shXuatKho.Range("F" & LastRow).Offset(, c) = .List(Idx, c)
                Next
                shXuatKho.Range("J" & LastRow) = .List(Idx, 3)
            End If
        Next
        .ForeColor = &H80000008
    End With
    cmdNhap.Enabled = False
End Sub

Các sự kiện của các nút lệnh khác:

Mã:
Private Sub cmdMark_Click()
    Dim Idx As Long
    For Idx = 0 To lbxDanhMuc.ListCount - 1
        lbxDanhMuc.Selected(Idx) = True
    Next
    cmdNhap.Enabled = True
End Sub

Private Sub cmdUnMark_Click()
    lbxDanhMuc.ForeColor = &H80000008
    cmdNhap.Enabled = False
End Sub

Private Sub cmdThoat_Click()
    Unload Me
End Sub
 

File đính kèm

  • ListChonNhieuMa_HTN.xlsm
    431.9 KB · Đọc: 173
Lần chỉnh sửa cuối:
Upvote 0
MÔ TẢ CÔNG VIỆC:

Trên sheet 'Xuat Kho', bấm nút 'NHAP DU LIEU' để UserForm 'usfTimKiem' xuất hiện.

Trên Form có:

2 TextBox: Tìm theo mã hàng Tìm theo tên hàng.

1 ListBox: Danh sách các mặt hàng (bao gồm ID, Tên, Đơn giá). Nó sẽ hiển thị kết quả tìm kiếm dựa trên các TextBox nói trên.

4 CommandButton: Đánh dấu tất cả, Hủy đánh dấu tất cả, Nhập đánh dấu, Thoát Form.

- Khi tìm kiếm theo mã hay tên hàng, bạn gõ vào các 1 trong 2 TextBox, phần lọc ra sẽ hiển thị trên ListBox.

- Click chuột vào mục nào (hàng nào) bạn cần đánh dấu trên ListBox. Sau khi được đánh dấu thì nút Nhập đánh dấu sẽ được khả dụng, ngược lại, nếu không có mục nào được đánh dấu thì nút này sẽ không khả dụng.

- Bạn cũng có thể chọn tất cả các hàng bằng cách bấm vào nút Đánh dấu tất cả, ngược lại bạn cũng có thể bấm vào nút Hủy đánh dấu tất cả.

- Bấm vào nút Nhập đánh dấu để nhập tất cả các mục đã được đánh dấu xuống sheet.

CÁC CODE TRONG USERFORM:

Khởi động Form:

Mã:
Private Sub UserForm_Initialize()
    Dim LastRow As Long
    Dim shBangMa As Worksheet
    
    Set shBangMa = Sheets("Bang Ma Hang Hoa")
    LastRow = shBangMa.Range("B" & Rows.Count).End(xlUp).Row
    
    priArrList = shBangMa.Range("B2:E" & LastRow)
    priUBound = UBound(priArrList)
    
    lbxDanhMuc.List = priArrList
End Sub

Thủ tục tìm kiếm theo Mã hàng hoặc theo Tên hàng:

Mã:
Private Sub KeyFind(ByVal FindText As String, ByVal Column As Byte)
    
    cmdNhap.Enabled = False
    
    Dim c As Byte
    Dim StrItem As String
    Dim n As Long, r As Long
    Dim GetRows(), ArrFilter()
    
    StrItem = "*" & UCase(FindText) & "*"
    
    For r = 1 To priUBound
        If UCase(priArrList(r, Column)) Like StrItem Then
            n = n + 1
            ReDim Preserve GetRows(1 To n)
            GetRows(n) = r
        End If
    Next
    
    If n > 0 Then
        ReDim ArrFilter(1 To n, 1 To 4)
        For c = 1 To 4
            For r = 1 To n
                ArrFilter(r, c) = priArrList(GetRows(r), c)
            Next
        Next
        lbxDanhMuc.List = ArrFilter
    Else
        lbxDanhMuc.Clear
    End If
End Sub

Sự kiện tên các TextBox:

Mã:
Private Sub tbxMaHang_Enter()
    priCheck = False
End Sub

Private Sub tbxMaHang_Change()
    If priCheck Then Exit Sub
    If tbxTenHang > "" Then tbxTenHang = ""
    KeyFind tbxMaHang, 1
End Sub

Private Sub tbxTenHang_Enter()
    priCheck = True
End Sub

Private Sub tbxTenHang_Change()
    If Not priCheck Then Exit Sub
    If tbxMaHang > "" Then tbxMaHang = ""
    KeyFind tbxTenHang, 2
End Sub

Sự kiện để đánh dấu trên ListBox:

Mã:
Private Sub lbxDanhMuc_Change()
    Dim Idx As Long
    For Idx = 0 To lbxDanhMuc.ListCount - 1
        If lbxDanhMuc.Selected(Idx) = True Then
            cmdNhap.Enabled = True
            Exit Sub
        End If
    Next
    If Idx = lbxDanhMuc.ListCount Then
        cmdNhap.Enabled = False
    End If
End Sub

Nhập xuống sheet dữ liệu đã được đánh dấu:

Mã:
Private Sub cmdNhap_Click()
    Dim c As Byte
    Dim shXuatKho As Worksheet
    Dim Idx As Long, LastRow As Long
    
    Set shXuatKho = Sheets("Xuat Kho")
    LastRow = shXuatKho.Range("F" & Rows.Count).End(xlUp).Row
    
    With lbxDanhMuc
        For Idx = 0 To .ListCount - 1
            If .Selected(Idx) = True Then
                LastRow = LastRow + 1
                For c = 0 To 2
                    shXuatKho.Range("F" & LastRow).Offset(, c) = .List(Idx, c)
                Next
                shXuatKho.Range("J" & LastRow) = .List(Idx, 3)
            End If
        Next
        .ForeColor = &H80000008
    End With
    cmdNhap.Enabled = False
End Sub

Các sự kiện của các nút lệnh khác:

Mã:
Private Sub cmdMark_Click()
    Dim Idx As Long
    For Idx = 0 To lbxDanhMuc.ListCount - 1
        lbxDanhMuc.Selected(Idx) = True
    Next
    cmdNhap.Enabled = True
End Sub

Private Sub cmdUnMark_Click()
    lbxDanhMuc.ForeColor = &H80000008
    cmdNhap.Enabled = False
End Sub

Private Sub cmdThoat_Click()
    Unload Me
End Sub
Em cám ơn anh Nghĩa nhiều lắm... Em đã làm được rồi
 
Upvote 0
chào cả nhà, file "ListChonNhieuMa_HTN" rất hay, và hữu ích trong việc tham khảo học hỏi code vba excel.

bác cho em hỏi thêm cách thêm coment tự động khi trỏ chuột vào 1 ô trong excel, em tìm mãi mà chưa thấy

thanks bác nhiều ạ.



1656106674459.png
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom