(تمت الإجابة) فرز البيانات الغير موجود في النتائج وموجودة في البيانات الاساسية

[MGS]

بارك الله فيك اخى الكريم هذا والله هو المطلوب

اخى الكريم ارسل لك ملف اخر احتاج الى عمليه فرز للبيانات ولا يمكننى التوصل اليها الا يدويا هل يمكن بالمعادلات .

الفرز.rar

[عبدالله المجرب]

اخي الفاضل

جرب المرفق حسب فهمي للمطلوب

ابواحمد

الفرز.rar

[MGS]

احسنت اخى الفاضل بارك الله فيك وفى علمك

[عبدالله المجرب]

وهذا حل أخر بإستخدام الاكواد

قم بمسح المعادلة من عمود النواقص

ثم ضع الكود في زر أمر

عند الضغط على زر الامر سيتم إستخراج البيانات الغير مكررة ولصقها في عمود النواقص

Sub OFFICNA()

Application.ScreenUpdating = False

LR = Sheets("Sheet2").Range("e" & Rows.Count).End(xlUp).Row + 1

Range("E2:E" & LR).ClearContents

For i = 2 To 12

x = Application.WorksheetFunction.CountIf(Range("C2:C12"), Cells(i, 1))

If x = 0 Then

LR1 = Sheets("Sheet2").Range("e" & Rows.Count).End(xlUp).Row + 1

Cells(i, 1).Copy Range("E" & LR1)

End If

Next i

Application.ScreenUpdating = True

End Sub

ابواحمد

[ياسر الحافظ]

الف شكر اخونا الاستاذ " ابو احمد " عبد الله المجرب

كلنا نستفيد من هذه الاعمال الرائعة

وفقك الله

ابو الحارث

[MGS]

• بارك الله فيك اخى الفاضل ولكن كيف يمكن استخدام التعديل فى الكود حتى يمكننى استخدام البيانات الأساسيه من شيت اخر وليس نفس الشيت
  

2الفرز.rar

[عبدالله المجرب]

اخي الفاضل

هكذا سيصبح الكود

Sub missing()

Application.ScreenUpdating = False

LR = Sheets("Sheet2").Range("f" & Rows.Count).End(xlUp).Row + 1

Range("f2:f" & LR).ClearContents

For i = 2 To 12

x = Application.WorksheetFunction.CountIf(Range("d2:d12"), Sheets("Sheet3").Cells(i, 1))

If x = 0 Then

LR1 = Sheets("Sheet2").Range("f" & Rows.Count).End(xlUp).Row + 1

Sheets("Sheet3").Cells(i, 1).Copy Range("f" & LR1)

End If

Next i

Application.ScreenUpdating = True

End Sub

قم باستبدال هذا الكود بالسابق

لا تغير مكان زر امر استدعاء الكود

ابواحمد

[MGS]

وهذا حل أخر بإستخدام الاكواد

قم بمسح المعادلة من عمود النواقص

ثم ضع الكود في زر أمر

عند الضغط على زر الامر سيتم إستخراج البيانات الغير مكررة ولصقها في عمود النواقص

Sub OFFICNA()

Application.ScreenUpdating = False

LR = Sheets("Sheet2").Range("e" & Rows.Count).End(xlUp).Row + 1

Range("E2:E" & LR).ClearContents

For i = 2 To 12

x = Application.WorksheetFunction.CountIf(Range("C2:C12"), Cells(i, 1))

If x = 0 Then

LR1 = Sheets("Sheet2").Range("e" & Rows.Count).End(xlUp).Row + 1

Cells(i, 1).Copy Range("E" & LR1)

End If

Next i

Application.ScreenUpdating = True

End Sub

ابواحمد

بارك الله فيك يا ابو احمد تمام والله تمام

[ياسر الحافظ]

تشكر استاذنا " ابو احمد " عبـــــــــــــد الله المجرب

جزاك الله كل الخير ... وفقك الله

ابو الحارث