Sub Loc_co_dk()
Dim rng As Range
[B8:F1000].ClearContents
With Sheet1
.Range(.[A3], .[H65536].End(3)).AdvancedFilter 2, [C2:C3], [C7:E7]
Set rng = .Range(.[B65536].End(xlUp), .[B4]).Find([C3], , xlFormulas, xlWhole) 'tim 1 gia tri duy nhat' + row an?
If Not rng Is Nothing Then
[C4] = rng.Offset(, -1)
[C5] = rng.Offset(, 1)
[C6] = rng.Offset(, 2)
Range([C8], [C65536].End(3)).Offset(, -1) = [row(a:a)]
[COLOR=#0000ff]Else
MsgBox "khong co Ma này"[/COLOR]
End If
End With
End Sub
Sub Loc_co_dk()
Dim findRng As Range
With Sheet2
Set findRng = Range(Sheet1.[B4], Sheet1.[B65536].End(xlUp)) _
.Find(.[C3], LookIn:=xlValues, LooKat:=xlWhole)
.[B8:F1000,C4,C5,C6].ClearContents
If findRng Is Nothing Then
MsgBox "Khong co so phieu nay!", , "Coi Lai!!!!"
.[C3].ClearContents
Else
Range(Sheet1.[A3], Sheet1.[I65536].End(3)).AdvancedFilter 2, .[C2:C3], .[C7:F7]
.[C4] = findRng.Offset(, -1).Value
.[C5] = findRng.Offset(, 1).Value
.[C6] = findRng.Offset(, 2).Value
Range(.[C8], .[C65536].End(3)).Offset(, -1) = [row(a:a)]
End If
Set findRng = Nothing
End With
End Sub
Sub Loc_co_dk()
Dim srcRng As Range, findRng As Range, cellAddress As String
With Sheet2
Set srcRng = Sheet1.Range(Sheet1.[B4], Sheet1.[B65536].End(xlUp))
Set findRng = srcRng.Find(.[C3], LookIn:=xlValues, LookAt:=xlWhole)
.[B8:F1000,C4,C5,C6].ClearContents
If findRng Is Nothing Then
MsgBox "Khong co so phieu nay!", , "Coi Lai!!!!"
.[C3].ClearContents
Else
cellAddress = findRng.Address
Do
.[C4] = findRng.Offset(, -1).Value
.[C5] = findRng.Offset(, 1).Value
.[C6] = findRng.Offset(, 2).Value
.[C65536].End(xlUp).Offset(1).Resize(, 3).Value = findRng.Offset(, 4).Resize(, 3).Value
Set findRng = srcRng.FindNext(findRng)
Loop Until findRng.Address = cellAddress
End If
Set findRng = Nothing
Set srcRng = Nothing
End With
End Sub
Theo mình nên làm theo cách này: Nhập dữ liệu bằng Form, khi gõ kí tự đầu tiên của từ cần tìm ví dụ chữ c là nó sẽ hiện lên các phiếu có kí tự đầu tiên là chữ c, ví dụ chuot0106, chuot0107, chuotdong, chuotbach...
Sub Loc_co_dk()
Dim srcRng As Range, findRng As Range, currRng As Range, cellAddress As String
With Sheet2
Set srcRng = Sheet1.Range(Sheet1.[B4], Sheet1.[B65536].End(xlUp))
Set findRng = srcRng.Find(.[C3], LookIn:=xlValues, LookAt:=xlWhole)
.[B8:F1000,C4,C5,C6].ClearContents
If findRng Is Nothing Then
MsgBox "Khong co so phieu nay!", , "Coi Lai!!!!"
.[C3].ClearContents
Else
Set currRng = .[C65536].End(xlUp).Offset(1)
cellAddress = findRng.Address
Do
.[C4] = findRng.Offset(, -1).Value
.[C5] = findRng.Offset(, 1).Value
.[C6] = findRng.Offset(, 2).Value
currRng.Resize(, 3).Value = findRng.Offset(, 4).Resize(, 3).Value
currRng.Offset(, 3).Value = findRng.Row
Set findRng = srcRng.FindNext(findRng)
Set currRng = currRng.Offset(1)
Loop Until findRng.Address = cellAddress
End If
Set findRng = Nothing
Set srcRng = Nothing
Set currRng = Nothing
End With
End Sub
Sub SuaSLX()
Dim TenHH As Range
Application.ScreenUpdating = False
Set TenHH = Sheet2.[C65536].End(xlUp)
Do While TenHH.Row > 7
Sheet1.Range("H" & TenHH.Offset(, 3).Value).Value = TenHH.Offset(, 2).Value
Set TenHH = TenHH.Offset(-1)
Loop
MsgBox ("Sua phieu xong")
SortNgay
Sheet2.[B8:F1000,C3,C4,C5,C6].ClearContents
Application.ScreenUpdating = True
End Sub
