Dùng phương thức Find (1 người xem)

[quykh]

Em có file này mong các AC chỉnh lại dùng phương thức Find. Chứ tìm phiếu xuất trong validation cỡ 100 phiếu thì mỏi mắt lắm. Nếu tìm không thấy thì hiện MsgBox" Số Phiếu Này Không Có". Mong các AC giúp đỡ.

 

[quykh]

Cám ơn bạn choioi nhe, như mình đã nói là không dùng validation hay ListBox để chọn, mà gỏ thẳng vào Cell C3.(File của bạn mình thấy chạy hơi lâu).

Với Anh Siwtom, mình có thể không cho hiện Data Row được không Anh????(Bỏ hẳn luôn)
Cám ơn Bạn Choioi và Anh Siwtom rất nhiều!!!!!

 

[siwtom]

Với Anh Siwtom, mình có thể không cho hiện Data Row được không Anh????(Bỏ hẳn luôn)

Thì chiều.
Thực ra tôi chỉ thích chiều con gái - mọi lúc mọi nơi - nhưng tôi cho bạn trường hợp ngoại lệ.

Có thể nhớ chỉ số dòng trong cell.ID. Tuy ít ai dùng tới thuộc tính ID của cell nhưng trong trường hợp trong một code bạn lại dùng cả code của ông siwtom thứ hai mà ông ta cũng dùng ID thì rách việc. Lúc đó thì nhớ chỉ số dòng trong mảng.

Phiên bản dùng cell.ID

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.ID = 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.ID).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

Phiên bản dùng mảng

Private ArrIndex() As Long

Sub Loc_co_dk()
Dim srcRng As Range, findRng As Range, currRng As Range, cellAddress As String, count As Long
    ReDim ArrIndex(1 To 1)
    
    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
                count = count + 1
                ReDim Preserve ArrIndex(1 To count)
                ArrIndex(count) = 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, count As Long
    Application.ScreenUpdating = False
    Set TenHH = Sheet2.[C65536].End(xlUp)
    Do While TenHH.Row > 7
        count = count + 1
        Sheet1.Range("H" & ArrIndex(count)).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

 

[quykh]

Sao Anh nghĩ Em là con trai, Em chính hiệu là con gái nheo nhẻo mà!!!!! Anh chiều Em đi, Em không để Anh thiệt thòi đâu. Ah mà Anh Siwtom ơi, sao code của Anh nó kỳ dzậy. Khi em thay đổi SL thực xuất của mặt hàng dưới thì SL đó nhảy lên mặt hàng trên.
Ví dụ như phiếu có 3 mặt hàng: nhãn may = 100
dây treo =20
thun more = 80
Em thay SL thun more = 90 thì kết quả như sau: nhãn may = 90
dây treo = 20
thun more = 100
Tức là nó thay SL của mặt hàng trên cùng và SL trên cùng xuống mặt hàng cuối cùng.còn mặt hàng ở giữa thì không sao. Vấn đề này xảy ra khi dùng phiên bản mảng, còn phiên bản Cell.ID thì không. Mong Anh giúp Em!!!!

 

[siwtom]

Sao Anh nghĩ Em là con trai, Em chính hiệu làcon gái nheo nhẻo mà!!!!! Anh chiều Em đi, Em không để Anh thiệt thòi đâu.

Bạn nói với con trai như thế thì khổ con trai rồi. Khổ nỗi tôi lại có trí tưởng tượng hơi bị tốt, hơi bị bay bổng. Đêm nay không ngủ được rồi.

Ah mà Anh Siwtom ơi, sao code của Anh nó kỳ dzậy. Khi em thay đổi SL thực xuất của mặt hàng dưới thì SL đó nhảy lên mặt hàng trên.
Ví dụ như phiếu có 3 mặt hàng: nhãn may = 100
dây treo =20
thun more = 80
Em thay SL thun more = 90 thì kết quả như sau: nhãn may = 90
dây treo = 20
thun more = 100
Tức là nó thay SL của mặt hàng trên cùng và SL trên cùng xuống mặt hàng cuối cùng.còn mặt hàng ở giữa thì không sao. Vấn đề này xảy ra khi dùng phiên bản mảng, còn phiên bản Cell.ID thì không. Mong Anh giúp Em!!!!

He he, nhầm.
Trong Sub SuaSLX tôi duyệt cột C từ dưới lên nhưng lại lấy chỉ số dòng trong mảng ArrIndex từ đầu về cuối. Phải lấy từ cuối về đầu (thụt lùi)

code mới của SuaSLX

Sub SuaSLX()
Dim TenHH As Range, count As Long
    Application.ScreenUpdating = False
    Set TenHH = Sheet2.[C65536].End(xlUp)
    Do While TenHH.Row > 7
        count = count + 1
        Sheet1.Range("H" & ArrIndex([B][COLOR=#ff0000]UBound(ArrIndex) - count + 1[/COLOR][/B])).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

Tức ở chỗ đỏ đỏ trong code cũ là count. Bây giờ phải là đỏ đỏ.