ترحيل بعدة شروط

[Ali Mohamed Ali]

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

أرجو من الأخوة الزملاء والخبراء الأعزاء فى هذا المنتدى الكبير التكرم على مساعدتى فى هذه المعادلة

المطلوب داخل الملف

 

transfer.rar

[Ali Mohamed Ali]

للرفع-أرجو مساعدة الأستاذ بن علية حاجى والأستاذ سليم حاصبيا والأساتذة الخبراء

[ابراهيم الحداد]

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

انسخ هذا الكود والصقه فى موديول و خصص له زر

Sub TransferData()
Dim ws As Worksheet, Sht As Worksheet
Dim Arr As Variant, Temp As Variant
Dim i As Long, j As Long, p As Long
Dim Nam As String, Trip As String
Dim StrDate As Date, EnDate As Date

Set ws = Sheets("from 01.12 till 15.12.2017")
Set Sht = Sheets("Copy")
Nam = ws.Range("I1")
Trip = ws.Range("I2")
StrDate = ws.Range("J1")
EnDate = ws.Range("J2")
ws.Range("A5:L" & ws.Range("E" & Rows.Count).End(xlUp).Row + 4).ClearContents
Arr = Sht.Range("A2:AF" & Sht.Range("G" & Rows.Count).End(xlUp).Row).Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 5) Like "*" & Trip & "*" And Arr(i, 6) >= StrDate And Arr(i, 6) <= EnDate And Arr(i, 7) Like "*" & Nam & "*" Then
p = p + 1
For j = 1 To 12
Temp(p, j) = Arr(i, Choose(j, 1, 4, 5, 6, 7, 8, 9, 11, 12, 13, 15, 20))
Next
End If
Next
If p > 0 Then ws.Range("A5").Resize(p, UBound(Temp, 2)).Value = Temp
End Sub

 

[Ali Mohamed Ali]

ممكن بعد إذن أستاذنا الكبير زيزو سوف أرسل لك الملف ثانية بعد وضع الكود به

 

ولكنه لا يعمل أرجو عمل اللازم من فضلك-بارك الله فيك ورعاك وأشكرك على سرعة الرد

 

transfer.rar

تم تعديل فبراير 5, 2018 بواسطه ali mohamed ali

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

2 ساعات مضت, ali mohamed ali said:

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

أرجو من الأخوة الزملاء والخبراء الأعزاء فى هذا المنتدى الكبير التكرم على مساعدتى فى هذه المعادلة

المطلوب داخل الملف

 

transfer.rar

كي يعمل الكوط للتصقيى 

يجب ان تكون كل كلمة من  محتويات الصف الاول من الجدول مطابقة تماماً(حتى المسافات بين الكلمات) لما يقابلها في الجدول الثاني و هذا لا الاحظه في الجدولين

جرب قبل كل شيء هذه المعادلة في الحلية A3 من الورقة الاولى وانسخها الى الصف كله فلا ترى الا    True   واجدة

=OR(A4=Copy!$A$1:$AF$1)

 

[Ali Mohamed Ali]

شاكر لك أستاذنا الكبير زيزو وكل تقديرى للأستاذ العزيز سليم حاصبيا بارك الله لكما

وهذا هو الملف بعد الإصلاح لتعم الإفادة للأخرين ويعمل الكود الأن بكل بساطة

 

transfer.rar

تم تعديل فبراير 5, 2018 بواسطه ali mohamed ali