AnhThu-1976
Thành viên tích cực
- Tham gia
- 17/10/14
- Bài viết
- 1,061
- Được thích
- 175
Các anh/chị thêm code giùm em trường hợp sau:
Tại sheet Data cột H, em sẽ tiến hành tìm Mã, Nếu tìm mã không thấy thì "SAU KHI EM BẤM OK" thì nó sẽ thoát khỏi Form, đồng thời con trỏ sẽ nhảy qua Sheet Note1 ở dòng trống cuối cùng trong danh sách (cell cuối cùng ở đây đang là cell H35) để em nhập mã mới
P/s: code này em tìm được trên GPE
Em cảm ơn
Tại sheet Data cột H, em sẽ tiến hành tìm Mã, Nếu tìm mã không thấy thì "SAU KHI EM BẤM OK" thì nó sẽ thoát khỏi Form, đồng thời con trỏ sẽ nhảy qua Sheet Note1 ở dòng trống cuối cùng trong danh sách (cell cuối cùng ở đây đang là cell H35) để em nhập mã mới
P/s: code này em tìm được trên GPE
Em cảm ơn
Mã:
Private Sub CB_Tim_Click()
With Application
.ScreenUpdating = False
End With
Dim endR As Long, i As Long, s As Long, k As Long
Dim arr(), arrKQ()
Dim MaHHTim As String
With Sheets("Note1")
endR = .Cells(65000, 8).End(xlUp).Row
arr = .Range(.Cells(10, 8), .Cells(endR, 10)).Value
End With
ReDim arrKQ(1 To endR, 1 To 3)
s = 0
MaHHTim = Me.NhomHang.Value
For i = 1 To UBound(arr)
If InStr(UCase(arr(i, 1)), UCase(MaHHTim)) Then
s = s + 1
For k = 1 To 3
arrKQ(s, k) = arr(i, k)
Next k
End If
Next i
If s = 0 Then
MsgBox "No Ma"
Me.NhomHang.SetFocus
With Me.MHList
.ColumnCount = 5
.List = arr
End With
End If
With Me.MHList
.Clear
.ColumnCount = 5
.List = arrKQ
End With
With Application
.ScreenUpdating = False
End With
Erase arr(), arrKQ()
End Sub
Private Sub Nhap_Click()
On Error Resume Next
Dim j&, i&, SelectItem
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
j = ActiveCell.Row
If ActiveSheet.Name = "Data" Then
ActiveSheet.Select
For i = 0 To MHList.ListCount - 1
If MHList.Selected(i) Then
Cells(j, 8) = MHList.List(i)
Cells(j, 9) = MHList.List(i, 1)
Cells(j, 10) = MHList.List(i, 2)
j = j + 1
SelectItem = 1
End If
Next
End If
If SelectItem = 0 Then
MsgBox "Ban da khong chon ten nao trong danh sach !"
End If
Unload Me
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Private Sub NhomHang_AfterUpdate()
CB_Tim.SetFocus
End Sub
Private Sub Thoat_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim endR As Long
Dim arr()
With Sheets("Note1")
endR = .Cells(65000, 8).End(xlUp).Row
arr = .Range(.Cells(10, 8), .Cells(endR, 10)).Value
End With
With Me.MHList
.ColumnCount = 3
.List = arr
End With
'MHList.Selected(0) = True
NhomHang.SetFocus
Erase arr
End Sub
Lần chỉnh sửa cuối:
