زيادة عدد الايام في التاريخ والاضافة الى خلية جديدة تجزئة خزن التاريخ بعد الزيادة

[prog55555]

مرحبا...
احبتي مرفق ملف اكسيل يحتوي على 4 اعمدة وهي كما يلي
1-رقم العميل
2-تاريخ السكن
3-عدد الايام
4-نوع الحجز

المطلوب عندما اقوم بأدخال الاتي

123        10/10/2020         3           A


يقوم بعملية اضافة المعلومات الى صفحة جديدة في نفس الملف اسمها info ويكون الخزن كما يلي وحسب زيادة عدد الايام وهنا عدد الايام 3 فبقوم بالزيادة من تاريخ 10/10/2020 للعميل 123 


123 10/10/2020 A
123 11/10/2020 A
123 12/10/2020 A



يعني المطلوب اضافة التاريخ وتجزئته حسب الزيادة

 

الملف

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

كان من المفروض رفع ملف ولا تدع من يريد المساعدة ان يفعل ذلك

 التكرارات لا ترحل

Option Explicit

Sub MY_DATA()
Dim M As Worksheet, O As Worksheet
Dim Rg_M As Range, Rg_O As Range
Dim Ro_M%, i%, How_Many%, _
    Ro_O%, t%, n%
Dim arr()

Set M = Sheets("Main"): Set O = Sheets("Out")
Ro_M = M.Cells(Rows.Count, 1).End(3).Row
If Ro_M = 1 Then Exit Sub
Ro_O = O.Cells(Rows.Count, 1).End(3).Row + 1
 For i = 2 To Ro_M
      How_Many = M.Cells(i, 3)
      ReDim arr(How_Many - 1, 3)
      n = 0
         For t = LBound(arr) To UBound(arr)
            arr(t, 0) = M.Cells(i, 1)
            arr(t, 1) = M.Cells(i, 2) + n
            arr(t, 2) = M.Cells(i, 3)
            arr(t, 3) = M.Cells(i, 4)
             n = n + 1
          Next t
     
     O.Cells(Ro_O, 1). _
     Resize(UBound(arr) + 1, 4).Value = arr
     Ro_O = Ro_O + UBound(arr) + 1
     Erase arr: n = 0
Next i
  O.Range("A1").Resize(Ro_O - 1, 4).RemoveDuplicates _
  Columns:=Array(1, 2, 3, 4)
End Sub

الملف مرفق

prog55.xlsm

[أحمد يوسف]

prog55555

 

أين انت من  هذه الإجابة الممتازة؟!!! لم أرى اى ضغط على الإعجاب من طرفك , وهل جزاء الإحسان الا الإحسان ؟!!!!

أين الضغط على الإعــــجـــــاب , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!! 💙

 

 

•  
•