الفارق بين الارقام مطلوب كود

[محسن33]

ارقام الاختلاف.rar

[سليم حاصبيا]

جرب هذا الماكرو

Option Explicit

Sub Salim()
  Dim RoA%, RoB%, i%, a%, b%
  Dim Rg_B As Range, Rg_A As Range
  Dim x As Boolean, y As Boolean, z As Boolean
  Dim Dc As Object

  RoA = Cells(Rows.Count, 1).End(3).Row
  RoB = Cells(Rows.Count, 2).End(3).Row
  Set Rg_B = Range("B2:B" & RoB)
  Set Rg_A = Range("A2:A" & RoA)
  Set Dc = CreateObject("Scripting.Dictionary")
Range("D2").CurrentRegion.ClearContents
i = 2
Do Until i = RoA + 1
    If Cells(i, 1) = "" Then GoTo Next_i
        a = Application.CountIf(Rg_A, Cells(i, 1))
         x = a > 1
        b = Application.CountIf(Rg_B, Cells(i, 1))
         y = b > 0
        z = b < a And x And y
      If z Then
        Dc(Cells(i, 1).Value) = ""
      End If
Next_i:
     i = i + 1
 Loop
 If Dc.Count Then
  Range("D2").Resize(Dc.Count) = _
  Application.Transpose(Dc.keys)
 End If
End Sub

الملف مرفق

Mouhsen.xlsm

[محسن33]

السلام عليكم

الاخ/سليم حاصبيا

لم تضبط جرب تغير ارقام في العمود A

جرب ان يزيد عدد الصفوف في العمود A  اكثر من 100 صف

للاسف لم تضبط

 

[سليم حاصبيا]

يا أخي كلما عدلت في البيانات و بعد الانتهاء من التعديل (ولو كانوا 100 صف أو أكثر) اضغط الزر Run 

[أحمد يوسف]

        محسن33

أين انت من هذه الإجابة الممتازة للأستاذ ســــليم حاصبيا ؟!!!

أين الضغط على الإعــــجـــــاب لهذه الإجابة  , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!!🖤 حتى وان لم تتحصل على الإجابة المرجوة فهذا واجب عليك فيكفى اضاعة الوقت وشرف المحاولة للتوصل لما تريد والعمل هنا لوجه الله بدون تقاضى اجر فحتى هذا تبخل بع على من يساعدك !!!!!!!!!!!!!!