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ớ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 !
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
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 và 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
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 và 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