مساعدة في كود ترحيل البيانات مع اظهار شريط التقدم

[ابوسلماان]

Bar1.rar

الاعزاء

 

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

 

 

خالص محبتي للجميع،،

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

السلام عليكم أخي أبو سلمان

احتاج الى ترحيل الرصيد التراكمي لعمليات المخزون بحيث يظهر الرصيد التراكمي عند كل يوم موجود في الجدول السابق

وفي حالة عدم وجود حركة لأي يوم من الأيام اللي مذكورة في الجدول ،،  أو أن اليوم غير موجود أصلا في الجدول ،،  فارجو استبعاده من القائمة واخفاءه.   دا كلامك بس مفهمتش منه حاجة .. لأني لغتي في المنتدى هي الإكسيل مش تقولي رصيد وكمان تراكمي ومخزون ودياولو .. حدد هدفك لتصل إلى مبتغاك قول في ورقة العمل كذا والتي تعتبر ورقة البيانات الأصلية يوجد في النطاق كذا وكذا والمطلوب ترحيل البيانات بشرط كذا ويكون الترحيل لورقة كذا في الخلية كذا بالشكل كذا ويا حبذا لو أرفق بعض النتائج المتوقعة ..

[ابوسلماان]

حاضر يا عم  الحج ،،  وما تزقش 

المطلوب التالي:

1- في ورقة العمل Data ينقل التاريخ في النطاق B3  الى آخر صف في العمود B  .. وينقل الى الورقة Report العمود B ابتداء من الصف 4 بشرط ( أنه يوجد وارد أو منصرف لهذا التاريخ ).

2- ادراج عملية طرح في الورقة Data بين العمود C ( الوارد ) والعمود D ( المنصرف ) ونقلها الى الورقة Report  على العمود C بشرط أن تكون لنفس التاريخ و أن تاخذ بالاعتبار رصيد اليوم السابق ( نتائج عملية الطرح في الصف السابق تضاف الى نتائج عملية الطرح لليوم الحالي )

3 - عند القيام بعملية الترحيل هذه ،، يظهر شريط التقدم لمعرفة الوقت الذي تستغرقه عملية الترحيل.

 

وشكرا جزيلا ،، استاذنا ومعلمنا  ياسر

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

جرب الكود التالي لعله يفي بالغرض (ومن غير شريط تقدم هيكون سريع إن شاء الله)

Sub Test()
    Dim ws      As Worksheet
    Dim sh      As Worksheet
    Dim arr     As Variant
    Dim temp    As Variant
    Dim i       As Long
    Dim j       As Long
    Dim p       As Long
    Dim sW      As Double
    Dim sM      As Double
    
    Set ws = Sheets("Data")
    Set sh = Sheets("Report")

    arr = ws.Range("B2").CurrentRegion.Value
    ReDim temp(1 To UBound(arr, 1), 1 To 2)

    For i = 2 To UBound(arr, 1)
        If arr(i, 2) <> "" Or arr(i, 3) <> "" Then
            p = p + 1
            temp(p, 1) = arr(i, 1)
            sW = sW + Val(arr(i, 2))
            sM = sM + Val(arr(i, 3))
            temp(p, 2) = sW - sM
        End If
    Next i

    With sh
        .Columns("E:F").ClearContents
        .Range("E3:F3").Value = Array("التاريخ", "الرصيد التراكمي")
        .Range("E4").Resize(p - 1, UBound(temp, 2)).Value = temp
    End With
End Sub

 

[ابوسلماان]

رائع ،،  دائما مبدع  استاذنا ياسر

شكرا لك،،