اخر بيانات في صف

[tahar]

السلام عليكم

هل يوجد كود او دالة عند ادخال كود ياتي باخر ادخال في الضف

الشرح في المرفق

ppp.rar

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

جرب هدا 

=IFERROR(IF(A14="","",LOOKUP(2,1/(INDEX($B$2:$E$9,MATCH(A14,$A$2:$A$9,0),0)<>""),INDEX($B$2:$E$9,MATCH(A14,$A$2:$A$9,0),0))),"بدون نتيجة")

 أو  بإستخدام  vba 

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range, rngA As Range, rngB As Range, rngC As Range
    Dim OnRng As Variant, Code As Variant
    Dim result As String, col As Long
    
    Const msg As String = "بدون نتيجة"
    
    With Me
        Set rngA = .Range("A2:A9")
        Set rngB = .Range("B2:E9")
        Set rngC = .Range("A14:A21")
    End With
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    On Error GoTo CleanExit
    
    If Not Intersect(Target, Me.Range("A2:E9,A14:A21")) Is Nothing Then
        For Each cell In rngC
            If cell.Value <> "" Then
                OnRng = Application.Match(cell.Value, rngA, 0)
                
                If Not IsError(OnRng) Then
                    result = msg
                    For col = 5 To 2 Step -1
                        If Me.Cells(OnRng + 1, col).Value <> "" Then
                            result = Me.Cells(OnRng + 1, col).Value
                            Exit For
                        End If
                    Next col
                    cell.Offset(0, 1).Value = result
                Else
                    Code = cell.Value
                    cell.Resize(1, 2).Value = ""
                    MsgBox "الكود " & Code & " غير موجود", vbExclamation
                End If
            Else
                cell.Offset(0, 1).Value = ""
            End If
        Next cell
    End If

CleanExit:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

 

 

 

ppp2.xlsb

تم تعديل منذ 6 دقائق بواسطه محمد هشام.