اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

يمكن استعمال هذا الكود

Option Explicit
Dim My_rgA As Range, My_rgB As Range
Dim r%
'++++++++++++++++++++++++++++++++++
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Set My_rgA = Range("A2", Range("A1").End(4))
Set My_rgB = Range("B2", Range("B1").End(4))

If Target.Cells.Count = 1 Then
  Select Case Target.Address
   Case "$E$3": get_valB
   Case "$F$3": get_valA
  End Select
End If
Application.EnableEvents = True
End Sub
'++++++++++++++++++++++++++++++++++++++
Sub get_valB()

If Application.CountIf(My_rgA, Range("E3")) Then
r = My_rgA.Find(Range("E3"), lookat:=1).Row
 If r <> 0 Then Range("F3") = My_rgB.Cells(r - 1)
  Else
   Range("F3") = vbNullString
 End If

End Sub
'+++++++++++++++++++++++++++++++++++++
Sub get_valA()

If Application.CountIf(My_rgB, Range("F3")) Then
r = My_rgB.Find(Range("F3"), lookat:=1).Row
  If r <> 0 Then Range("E3") = My_rgA.Cells(r - 1)
  Else
    Range("E3") = vbNullString
  End If

End Sub

الملف مرفق

Double_formula.xlsm

  • Like 2
قام بنشر (معدل)

ابداع - تسلم 

واذا كانت البيانات في شيت (السجل)

والبحث في شيت اخر (البحث) 

اين يكون التعديل

 

تم تعديل بواسطه ابايوسف
  • أفضل إجابة
قام بنشر

في هذه الحالة

شيت Source  هي شيت المصدر  و شيت Salim هي شيت النتيجة

الكود اللازم

Option Explicit
Dim My_rgA As Range, My_rgB As Range
Dim r%
'++++++++++++++++++++++++++++++++++
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Set My_rgA = Sheets("Source").Range("A2", Sheets("Source").Range("A1").End(4))
Set My_rgB = Sheets("Source").Range("B2", Sheets("Source").Range("B1").End(4))

If Target.Cells.Count = 1 Then
  Select Case Target.Address
   Case "$E$3": get_valB
   Case "$F$3": get_valA
  End Select
End If
Application.EnableEvents = True
End Sub
'++++++++++++++++++++++++++++++++++++++
Sub get_valB()

If Application.CountIf(My_rgA, Range("E3")) Then
r = My_rgA.Find(Range("E3"), lookat:=1).Row
 If r <> 0 Then Range("F3") = My_rgB.Cells(r - 1)
  Else
   Range("F3") = IIf(Range("E3") = "", "", "Not Found")
 End If

End Sub
'+++++++++++++++++++++++++++++++++++++
Sub get_valA()

If Application.CountIf(My_rgB, Range("F3")) Then
r = My_rgB.Find(Range("F3"), lookat:=1).Row
  If r <> 0 Then Range("E3") = My_rgA.Cells(r - 1)
  Else
    Range("E3") = IIf(Range("F3") = "", "", "Not Found")
  End If

End Sub

الملف الجديد

 

 

Double_formula 2 Sheets.xlsm

  • Like 2

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information