Code nút Search PO (1 người xem)

[lmtuyen]

Thân chào Anh/Chị
mình sưu tầm được nút lệnh Search PO trên diễn đàn, và tùy biến lại như bên dưới
thì không hoạt động được.
Mục Đích là tìm đánh PO vào Textbox " Txtfind" thì nó sẽ Search ra số PO, và Số dòng hiện tại của PO đó, được hiển thị ở Label14, để mình update lại dữ liệu vào excell, Anh /Chị xem giúp.

Private Sub TxtFind_Change()
Dim iR As Long, jC As Byte, kR As Long, Tmp As Long, myArr(), lbArr()
On Error Resume Next
myArr = Sheet1.Range("b6" & Sheet1.[b65535].End(3).Row).Value
ReDim lbArr(1 To UBound(myArr), 1 To UBound(myArr, 2))
For iR = 1 To UBound(myArr)
Tmp = myArr(iR, 1)
If Tmp Like TxtFind & "*" Then
kR = kR + 1
For jC = 1 To UBound(myArr, 2)
lbArr(kR, jC) = myArr(iR, jC)
Next jC
End If
Next iR
If kR Then
lst1.List = lbArr
lst1.ColumnCount = UBound(myArr, 2)
'lit1.ColumnHeads = True
ElseIf TxtFind = Empty Then
lst1.List = myArr
Else
lst1.Clear
End If
End Sub

 

[nmhung49]

Bạn thêm đoạn code này

Label14.Caption = lst1.List(0, 0)

Dưới đoạn code

lst1.ColumnCount = UBound(myArr, 2)

 

[lmtuyen]

Mình thêm vào rồi, nhưng tìm không đúng ý mình, Bạn xem file đính kèm với hình nhé. mình có 15 cột, cột đầu tiến là cột mình đếm số dòng trong excell. Click vào từng PO , nhấn Edit để load dữ liệu và sữ dữ liểu thì OK, do mình làm bên kế hoạch hàng ngày thêm vào bớt ra cả 100 PO lận, nên mới làm nút Search cho tiện việc tìm kiếm-chỉnh sửa.

 

[nmhung49]

Mình quên sửa nút tìm kiểm đúng cột cho bạn, bạn thay code này
Tmp = myArr(iR, 1) thành Tmp = myArr(iR, 2)

 

[lmtuyen]

Thanks Bạn nhiều, rất đúng ý mình. hình như doạn code này của Bác Ndu hay Sealand, nhưng mình hiểu chưa hết nên tùy biến chưa được, Bạn có thể giúp giải thích đoạn bên dưới giúp nhé

ReDim lbArr(1 To UBound(myArr), 1 To UBound(myArr, 2))
For iR = 1 To UBound(myArr)
Tmp = myArr(iR, 1)
If Tmp Like TxtFind & "*" Then
kR = kR + 1
For jC = 1 To UBound(myArr, 2)
lbArr(kR, jC) = myArr(iR, jC)
Next jC
End If
Next iR
If kR Then
lst1.List = lbArr
lst1.ColumnCount = UBound(myArr, 2)
'lit1.ColumnHeads = True
ElseIf TxtFind = Empty Then
lst1.List = myArr
Else
lst1.Clear
End If
End Sub

 

[nmhung49]

Thanks Bạn nhiều, rất đúng ý mình. hình như doạn code này của Bác Ndu hay Sealand, nhưng mình hiểu chưa hết nên tùy biến chưa được, Bạn có thể giúp giải thích đoạn bên dưới giúp nhé

[GPECODE=vb]
Private Sub TxtFind_Change()


Dim iR As Long, jC As Byte, kR As Long, Tmp As Long, myArr(), lbArr()
'Khai bao bien
On Error Resume Next


myArr = Sheet1.Range("b6" & Sheet1.[b65535].End(3).Row).Value


'Gan gia tri tren sheet vao bien mang MyArr
ReDim lbArr(1 To UBound(myArr), 1 To UBound(myArr, 2))


'Tao lai bien mang lbArr cho phu hop voi du lieu se dua vao gom bao nhieu cot
'bao nhieu dong
For iR = 1 To UBound(myArr) 'vong lap duyet tu dong 1 cua bien mang myarr den het
Tmp = myArr(iR, 2) 'gan gia tri lay tu myarr dong thu iR cot 2 vao bien tmp


If Tmp Like TxtFind & "*" Then ' so sanh neu tmp giong voi textbox find thi
kR = kR + 1 'Neu thoa dieu kien tren thi cho bien kR tang len 1


For jC = 1 To UBound(myArr, 2) 'duyet vong lap tu cot 1 den cot cuoi cung cua bien mang Myarr
lbArr(kR, jC) = myArr(iR, jC) 'gan gia tri cua bien myarr theo dong cot vao mang ket qua lbArr
Next jC


End If

Next iR


If kR Then 'Xet neu ket qua tim thay thi
lst1.List = lbArr 'Gan mang vua tao duoc lbArr vao listbox
lst1.ColumnCount = UBound(myArr, 2) 'cot cua listbox = voi so cot tren sheet


'lit1.ColumnHeads = True
ElseIf TxtFind = Empty Then 'Neu tim khong thay thì
lst1.List = myArr 'gan listbox bang chinh toan bo gia tri tren sheet
Else
lst1.Clear 'Xoa toan bo du lieu tren listbox
End If


End Sub
[/GPECODE]

Tôi giải thích sơ sơ mong bạn hiểu