حذف صف في ملف اعتمادا على خلية في ملف اخر

[Dr.Basel-D]

السلام عليكم,

اريد طلب مساعدة في الكود ....

شرح طلبي :

1- اريد كود لمسح صف في ملف اكسل اعتمادا علي تواجد نفس القيمة في ملف اكسل اخر 

 

مثال :

workbook 1

A1 = اسم الملف المراد فتحه وحذف الصف منه

B:B = ارقام الفواتير المراد حذفها من الملف الاخر

workbook 2

A:A= ارقام فواتير 

 

عمل الكود: فتح الملف workbook 2 ثم البحث عن ارقام الفواتير الموجودة في B:B workbook 1 ثم تحديد الخلايا التى تحتوي على نفس ارقام الفواتير في الملف workbook 2 A:A ثم حذف الصف كامل.

 

جربت صمم الكود التالي ولكن عملية الحذف لم تتم ارجو المساعدة.

Private Sub CommandButton1_Click()
Dim WB1, WB2 As Workbook
Dim WS1, WS2 As Worksheet
Set WB1 = ThisWorkbook
CSN = Cells(1, 1)
Set WB2 = Workbooks.Open("C:\Users\Basel\Desktop\" & CSN & "")
Set WS1 = WB1.Worksheets("sheet1")
Set WS2 = WB2.Worksheets("Sheet1")

LastRow1 = WB1.WS1.Cells(Rows.Count, 1).End(xlUp).Offset(1, ).Row
LastRow2 = WB2.WS2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To 20
If WB1.WS1.Cells(i, 2).Value = WB2.WS2.Cells(i, 1).Value Then
WB2.WS2.Cells(i, 1).EntireRow.Delete

End If

Next i

End Sub

File.zip

[ياسر خليل أبو البراء]

أخي الكريم

لم أطلع على الملف في الحقيقة لضيق وقتي .. ولكن بإلقاء نظرة سريعة على الكود أجد أنه في الحلقة التكرارية لجأت إلى الأسلوب التسلسلي من 1 إلى 20 .. وللعلم عند الحذف يجب أن يتم عكس الحلقة لتتم بشكل منضبط أي أن الحلقة يجب أن تبدأ من 20 إلى 1 ثم تضيف كلمة Step -1  لتتناقص أثناء التكرار ..

أرجو أن يفيد ردي في حل الإشكال

تقبل تحياتي

[Dr.Basel-D]

منذ ساعه, ياسر خليل أبو البراء said:

أخي الكريم

لم أطلع على الملف في الحقيقة لضيق وقتي .. ولكن بإلقاء نظرة سريعة على الكود أجد أنه في الحلقة التكرارية لجأت إلى الأسلوب التسلسلي من 1 إلى 20 .. وللعلم عند الحذف يجب أن يتم عكس الحلقة لتتم بشكل منضبط أي أن الحلقة يجب أن تبدأ من 20 إلى 1 ثم تضيف كلمة Step -1  لتتناقص أثناء التكرار ..

أرجو أن يفيد ردي في حل الإشكال

تقبل تحياتي

جربت اخي الكريم بس ما نفع لو سمحت ساعدي اكثر جربت عدل باكود كمان ما نفع كالتالي:

Private Sub CommandButton1_Click()
Dim WB1, WB2 As Workbook
Dim WS1, WS2 As Worksheet
CSN = Cells(1, 1)
Set WB1 = ThisWorkbook
Set WB2 = Workbooks.Open("C:\Users\Basel\Desktop\" & CSN & "")
Set WS1 = WB1.Worksheets("sheet1")
Set WS2 = WB2.Worksheets("Sheet1")

LastRow1 = WB1.WS1.Cells(Rows.Count, 2).End(xlUp).Row
lastrow2 = WB2.WS2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = LastRow1 To 1 Step -1
For r = lastrow2 To 1 Step -1
If WB1.WS1.Cells(i, 2).Value = WB2.WS2.Cells(r, 1).Value Then
WB2.WS2.Cells(i, 1).EntireRow.Delete

End If

Next
Next

End Sub
 

 

شاكر افضالك اخي الغالي

تم تعديل أبريل 20, 2016 بواسطه Dr.Basel-D