ترحيل بشروط

[الذيب 2015]

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

تحياتي الى جميع الاساتذة والاعضاء الكرام

ترحيل بشروط معينة وموضحة بالمرفق 

 

 

TEXT.rar

 

تم تعديل نوفمبر 11, 2015 بواسطه الذيب 2015

[الـعيدروس]

جرب الكود التالي

Public Sub A_Add()
Dim Sh As Worksheet, Sht As Worksheet
Set Sht = Sheets("Sheet2")
Set Sh = Sheets("Sheet1")
i = 1
Lr = Sh.Cells(Rows.Count, 1).End(xlUp).Row
For Each R In Sh.Range("A1:J" & Lr).Rows
   A = Join(Application.Index(R.Value, 0), ",")
   B = Replace(A, "ES", "MR")
   B = Mid(B, 1, InStr(1, B, Split(B, ",")(3)) - 1) & Adm("0.00,", 3) & Split(B, ",")(7) & "." & String(2, "0") & Adm(",0.00", 2)
   A = A & String(3, "0")
   ii = Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
   Sht.Cells(ii, 1) = Choose(1, A, B)
   Sht.Cells(ii + 1, 1) = Choose(2, A, B)
   i = i + 1: ii = ii + 1
Next
End Sub
Private Function Adm(Strn$, Ln&)
    Adm = Application.Rept(Strn, Ln)
End Function

 

[الذيب 2015]

ابداااع والله .. فوق الخيال 

سلمت يمناك 

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

هذا هو المطلوب بالضبط ... 

[الذيب 2015]

عفوا أخي العيدروس ... الكود يعمل 100% والشهادة مجروحة فيكم ...

بعد الترحيل

المطلوب أن تكون صيغة التاريخ من dd/mm/yyyy  الى yyyy-mm-dd 

العكس مع اضافة (-)

وشكرا

 

[الـعيدروس]

 

تفضل

Public Sub A_Add()
Dim Sh As Worksheet, Sht As Worksheet
Dim R As Range
Set Sht = Sheets("Sheet2")
Set Sh = Sheets("Sheet1")
i = 1
Lr = Sh.Cells(Rows.Count, 1).End(xlUp).Row
For Each R In Sh.Range("A1:J" & Lr).Rows
   A = Join(Application.Index(R.Value, 0), ",")
   A = Formt(A, Split(A, ",")(4)): A = Formt(A, Split(A, ",")(5))
   B = Replace(A, "ES", "MR")
   B = Mid(B, 1, InStr(1, B, Split(B, ",")(3)) - 1) & Adm("0.00,", 3) & Split(B, ",")(7) & "." & String(2, "0") & Adm(",0.00", 2)
   A = A & String(3, "0")
   ii = Sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
   Sht.Cells(ii, 1) = Choose(1, A, B)
   Sht.Cells(ii + 1, 1) = Choose(2, A, B)
   i = i + 1: ii = ii + 1
Next
End Sub
Private Function Formt(R, Nm)
    Formt = Replace(R, Nm, Format(Nm, "yyyy-mm-dd"))
End Function
Private Function Adm(Strn$, Ln&)
    Adm = Application.Rept(Strn, Ln)
End Function

 

تم تعديل نوفمبر 12, 2015 بواسطه الـعيدروس

[الذيب 2015]

ما شاء الله ... تبارك الله...

بارك الله فيك ... كفيت ووفيت 

 

زادك الله علما