مقارنة متقدمة

[محسن33]

السلام عليكم لدي عمودين في حدود 200000 صف

اريد مقارنة العمودين واستخراج القيم المختلفة بينهم بالرغم من تكرارها في العمود الاخر

مرفق

لا داعى لضغط الملف طالما مساحته صغيره

 

مقارنة.xlsx

[حسونة حسين]

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

تفضل

مقارنة.xlsb

[عبدالله بشير عبدالله]

حل رائع معلمنا  حسونة حسين

تم تعديل الإثنين at 14:44 بواسطه عبدالله بشير عبدالله

[عمر الجزاوى]

استاذ حسونة حل رائع بعد اذنك ممكن تضيف لينا شرط ثالث ان الكود يظهر القيم المشتركة بين العمودين

[حسونة حسين]

تفضل اخى 

 

مقارنة.xlsb

[عمر الجزاوى]

استاذ حسونة الف شكرا  على الاهتمام انا كنت ببحث عن حل قريب ووجدت خلول بالدوال ولكن حلك بالكود رائع وجميل ومميز الف الف شكر

[حسونة حسين]

الشكر لله اخى

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

[محسن33]

السلام عليكم

شكرا على الحل للاخ العزيز حسونة حسين

ولكن جربت ادخل بيانات حتى الصف20000 وعند الضغط على الcommandbutton ظهر error

 

 

تم تعديل الثلاثاء at 00:47 بواسطه محسن33

[محمد هشام.]

اظن ان الكود المقترح من الاستاد @حسونة حسين   يشتغل بشكل جيد على العموم جرب هدا 

Option Explicit
Sub test()
    Dim arr As Variant, i As Long, Irow As Long
    Dim tmp1 As Object, tmp2 As Object, c As Variant
    Dim n As Variant, a As Variant, b As Variant
    Dim WS As Worksheet: Set WS = Sheets("Sheet1")
    
    Application.ScreenUpdating = False
    
    With WS
    Irow = .Columns("A:E").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        If Irow > 1 Then
            .Range("C2:E" & Irow).ClearContents
        End If
        
        arr = .Range("A2:B" & Irow).Value
        Set tmp1 = CreateObject("Scripting.Dictionary")
        Set tmp2 = CreateObject("Scripting.Dictionary")
        
        For i = 1 To UBound(arr, 1)
            If arr(i, 1) <> "" Then tmp1(arr(i, 1)) = True
            If arr(i, 2) <> "" Then tmp2(arr(i, 2)) = True
        Next i
        
        For Each n In tmp1
            If tmp2.exists(n) Then
                c = cnt(c, n)
                tmp2.Remove n
            Else
                a = cnt(a, n)
            End If
        Next n
        
        For Each n In tmp2
            b = cnt(b, n)
        Next n
        
        If Not IsEmpty(a) Then [C2].Resize(UBound(a), 1).Value = WorksheetFunction.Transpose(a)
        If Not IsEmpty(b) Then [D2].Resize(UBound(b), 1).Value = WorksheetFunction.Transpose(b)
        If Not IsEmpty(c) Then [E2].Resize(UBound(c), 1).Value = WorksheetFunction.Transpose(c)
        
        Application.ScreenUpdating = True
    End With
End Sub
Function cnt(arr As Variant, Value As Variant) As Variant
    If IsEmpty(arr) Then
        ReDim arr(1 To 1)
        arr(1) = Value
    Else
        ReDim Preserve arr(1 To UBound(arr) + 1)
        arr(UBound(arr)) = Value
    End If
    cnt = arr
End Function

 

 

 

مقارنة 3.xlsb

تم تعديل الثلاثاء at 04:09 بواسطه محمد هشام.

[حسونة حسين]

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

في 24‏/9‏/2024 at 03:28, محسن33 said:

ولكن جربت ادخل بيانات حتى الصف20000 وعند الضغط على الcommandbutton ظهر error

ما هو الخطأ الذي يظهر لانه لا يظهر اخطأء بعد وضع بيانات الي الصف ٢٠ ألف