Nhờ giúp tìm mã trùng ở Sh này với Sh khác

[tanlahill]

Nhờ các thành viên GPE sớm giúp tôi vấn đề như đã trình bày trong file gởi kèm. Cám ơn.

 

[Hai Lúa Miền Tây]

Bạn cũng có thể dùng code củ chuối như sau:

Sub Tim()
Dim ngay
Dim NguoiTT
Dim rFoundCell As Range
Set rFoundCell = Sheet1.Range("c5")
If WorksheetFunction.CountIf(TTT.Range("c8:c5000"), rFoundCell) > 0 Then
    With TTT.Range("c8:c5000")
        ngay = .Find(What:=rFoundCell, After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False).Offset(0, 10)
        NguoiTT = .Find(What:=rFoundCell, After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False).Offset(0, 11)
    End With
MsgBox "So phieu : " & rFoundCell & vbNewLine & "Da thanh toan ngay :" _
& ngay & vbNewLine & "Nguoi thanh toan la : " & NguoiTT
End If
End Sub

Bạn xem file nhé.

 

[ndu96081631]

Bạn cũng có thể dùng code củ chuối như sau:

Sub Tim()
Dim ngay
Dim NguoiTT
Dim rFoundCell As Range
Set rFoundCell = Sheet1.Range("c5")
If WorksheetFunction.CountIf(TTT.Range("c8:c5000"), rFoundCell) > 0 Then
    With TTT.Range("c8:c5000")
        ngay = .Find(What:=rFoundCell, After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False).Offset(0, 10)
        NguoiTT = .Find(What:=rFoundCell, After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False).Offset(0, 11)
    End With
MsgBox "So phieu : " & rFoundCell & vbNewLine & "Da thanh toan ngay :" _
& ngay & vbNewLine & "Nguoi thanh toan la : " & NguoiTT
End If
End Sub

Bạn xem file nhé.

Lở dùng Find rồi sao không dùng luôn, thêm COUNTIF vào làm gì vậy?

Sub Tim()
  Dim FRng As Range
  With Sheets("DL")
    With .Range(.[C8], .[C65536].End(xlUp))
      Set FRng = .Find(Sheets("TT").Range("C5").Value, , , xlWhole)
      If Not FRng Is Nothing Then
        MsgBox "So phieu: " & FRng & " da thanh toan" & vbLf & _
               "Ngay: " & FRng(, 11) & vbLf & _
               "Nguoi thanh toan: " & FRng(, 12)
      Else
        ''Code copy du lieu viet tai day
      End If
    End With
  End With
End Sub

 

[nghiaphuc]

Nhờ các thành viên GPE sớm giúp tôi vấn đề như đã trình bày trong file gởi kèm. Cám ơn.

Còn một cách khác cho bạn đây:

Sub KiemTraMa()
    Dim VT As Long
    Sheet3.Cells(1, 1).Formula = "=MATCH(TT!C5,DL!C8:C5000,0)"
    If IsError(Sheet3.Cells(1, 1)) Then
        TTT.Activate
        VT = [C65000].End(xlUp).Row + 1
        Cells(VT, 1).EntireRow.Insert
        Sheet1.[C5:C14].Copy
        Cells(VT, 3).PasteSpecial Paste:=xlValues, Transpose:=True
        Cells(VT, 2) = VT - 7
        Cells(VT, 13) = Date
        Cells(VT, 14) = "What's your name?"
    Else
        VT = Sheet3.Cells(1, 1)
        MsgBox "Phieu " & Sheet1.[C5] & " da thanh toan" & vbLf & _
            "Ngay " & TTT.Cells(VT + 7, 13) & vbLf & "Nguoi thanh toan: " & _
            TTT.Cells(VT + 7, 14), , "Thông báo"
    End If
End Sub