مسح صفوف بشرط ارجو المساعده

[moktashef]

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

المطلوب كما في المثال المرفق انه لو الرقم الي في العمود رقم 5 موجود في العمود رقم 6 بنفس القيمه ونفس رقم الفاتوره الي في اخر عمود يمسح الصفوف- يمسح الريكورد كله مش الخليه بس - الي فيها الارقام دي

test.rar

[moktashef]

ارجو المساعده ؟؟؟؟

 

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

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

Sub del_rows()
lrc = Cells(Rows.Count, "c").End(3).Row: lrd = Cells(Rows.Count, "d").End(3).Row
Set rgc = Range("c7:c" & lrc): Set rgd = Range("d7:d" & lrd)
  For Each celc In rgc
    For Each celd In rgd
      If IsEmpty(celc) Then Exit For
       If celc & " " & celc.Offset(0, 4) = celd & " " & celd.Offset(0, 3) Then
          rr = celd.Row
          Range(Cells(rr, 1), Cells(rr, 7)).Delete Shift:=xlUp
        End If
    Next
  
  Next
 End Sub

 

[moktashef]

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

الماكروا مسح الصفوف الي متكرره الي اطبق عليها الشرط انا عايزها تمسح كله وانا عندي اصلا 7000 ريكورد فا ممكن ده يطبق علي 7000 صف

ملحوظه : هل هو بيجيب المتكرر بغض النظر عن ترتيبه ممكن يكون الصف في اخر الجدول 

ولك كل الشكر مقدما علي تعب حضرتك

test (Autosaved).rar

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

1 ساعه مضت, moktashef said:

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

الماكروا مسح الصفوف الي متكرره الي اطبق عليها الشرط انا عايزها تمسح كله وانا عندي اصلا 7000 ريكورد فا ممكن ده يطبق علي 7000 صف

ملحوظه : هل هو بيجيب المتكرر بغض النظر عن ترتيبه ممكن يكون الصف في اخر الجدول 

ولك كل الشكر مقدما علي تعب حضرتك

test (Autosaved).rar

في هذه الحالة استعمل هذا الماكرو(اسرع للبيانات الكثيرة)

Sub del_rows1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lrc = Cells(Rows.Count, "c").End(3).Row: lrd = Cells(Rows.Count, "d").End(3).Row
Set rgc = Range("c7:c" & lrc): Set rgd = Range("d7:d" & lrd)
  For Each celc In rgc
    For Each celd In rgd
      If IsEmpty(celc) Then Exit For
       If celc & " " & celc.Offset(0, 4) = celd & " " & celd.Offset(0, 3) Then
          rr = celd.Row
          Range(Cells(rr, 1), Cells(rr, 7)).Delete Shift:=xlUp
        End If
    Next
  
  Next
  Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 End Sub

 

[moktashef]

ااسف معلمي ولك جزيل الشكر بس الكود عاليه مشتغلش مع كل الصفوف 

هل حضرتك ممكن تجربهولي علي الفايل المرفق انا ملون الصفوف الي مفروض تتمسح 

وشكرا بجد علي مجهودك

test (Autosaved).rar

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

جرب هذا الملف

صفحة Salim

 

test (Autosaved) salim.rar

[moktashef]

مستر سليم ااسف علي ازعاجك ومقدر تعب حضرتك بس معلش النتيجه مابتطلعش زي المفروض تطلع 

انا جايب لحضرتك المثال و النتيجه المفروض تطلع تحت الجدول ممكن حضرتك تشوفه

test 2 (Autosaved) salim.rar

[moktashef]

اضافه الي ماسبق انا شفت ان لو رقم موجود في عمود رقم 5 بنفس رقم الفاتوره بيتمسح مع ان المفروض مايتمسحش

معلش انا اسف مره ثانيه للازعاج

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

ممكن ان يكون الحل المناسب

Sub del_rows_Salim()

   Application.ScreenUpdating = False
  lrc1 = Cells(Rows.Count, "c").End(3).Row
   Range("y7").FormulaArray = "=IFERROR(MATCH(C7&G7,$D$7:$D$30&$G$7:$G$30,0),""A"")"
    Range("y7").AutoFill Destination:=Range("y7:y" & lrc1)
   Range("z7").FormulaArray = "=IFERROR(MATCH(D7&G7,$C$7:$C$30&$G$7:$G$30,0),""B"")"
  Range("z7").AutoFill Destination:=Range("z7:z" & lrc1)
        For x = lrc1 To 7 Step -1
            If Cells(x, "y") = Cells(x, "z") Then Range(Cells(x, 1), Cells(x, 7)).Delete Shift:=xlUp
        Next
   Range("y:z").ClearContents
  Application.ScreenUpdating = True

 End Sub

المرفق

 

test (Autosaved) salim1.rar

[moktashef]

استاذ سليم معلش انا باعت لحضرك الملف ده ممكن تشوفه انا كاتب جمب الصفوف الي مفروض تتمسح كاتب جمبها should delete

لان الكود مابيحققش النتيجه بس ان شاء الله ماتعبش حضرتك وتكون كده واضح المطلوب وجزاك الله خيرا

test (Autosaved) salim2.rar

[moktashef]

؟؟

 

[moktashef]

?