كود يقوم مطابقة البيانات ثم ترحيلها

[محمود أبوسيف]

مطلوب كود

يقوم بمطابقة الأصناف وأنوعها الموجودة في صفحة المشتروات

بالأصناف وأنوعها الموجودة في صفحة المبيعات

ثم ترحيلهم حسب ماتم بيعه إلي صفحة جرد البضاعة

وذلكمن خلال زر بالفورم

ترحيل المشتريات و المبيعات.rar

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

أخي الكريم محمود

إن شاء الله ليلاً إذا تيسر لي وقت سأحاول العمل على ملفك .. ربنا ييسر الأمور

تقبل تحياتي

[محمود أبوسيف]

أشكرك أخي الكريم أبو البراء علي إهتمامك

[أبوعيد]

السلام عليكم

أخي محمود هذا حل بمعادلات الصفيف

تفضل

ترحيل المشتريات و المبيعات1.rar

[محمود أبوسيف]

الأستاذ أبو عيد أشكرك جدا لإهتمامك بالموضوع ولكن المطلوب أولاً هو 

 كود

يقوم بمطابقة الأصناف وأنوعها الموجودة في صفحة المشتروات

بالأصناف وأنوعها الموجودة في صفحة المبيعات

ثم ترحيلهم حسب ماتم بيعه إلي صفحة جرد البضاعة

وذلك من خلال زر بالفورم

وليس حساب الكمية عموماً أقدر مجهودك الرائع وأشكرك علي المتابعة

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

أخي الكريم محمود

جرب الكود التالي عله يكون المطلوب ...

Private Sub CommandButton1_Click()
    Dim Coll As New Collection, arrData, arrOut, arrStrSheet, strSheet, arrBlank, arrTemp
    Dim I As Long, J As Long, K As Long, strKey As String
    
    arrStrSheet = Array("المشتروات", "المبيعات")
    ReDim arrBlank(0 To 4)
    
    For K = LBound(arrStrSheet) To UBound(arrStrSheet)
        With Sheets(arrStrSheet(K))
            arrData = .Range("C6:E" & Application.Max(.Cells(.Rows.Count, "C").End(xlUp).Row, .Range("C6").Row)).Value
            On Error Resume Next
            For I = 1 To UBound(arrData, 1)
                strKey = Trim$(arrData(I, 1) & Chr$(2) & arrData(I, 2))
                arrTemp = arrBlank
                arrTemp = Coll(strKey)
                arrTemp(0) = arrData(I, 1)
                arrTemp(1) = arrData(I, 2)
                arrTemp(K + 2) = arrTemp(K + 2) + arrData(I, 3)
                Coll.Remove strKey
                Coll.Add Key:=strKey, Item:=arrTemp
            Next I
            On Error GoTo 0
        End With
    Next K
    
    ReDim arrOut(1 To Coll.Count, 1 To 5)
    I = 0
    For Each arrTemp In Coll
        I = I + 1
        For J = 0 To 3
            arrOut(I, J + 1) = arrTemp(J)
        Next J
        arrOut(I, 5) = arrOut(I, 3) - arrOut(I, 4)
    Next arrTemp
    
    With Sheets("جرد البضاعة").Range("B5")
        .CurrentRegion.Offset(1, 1).ClearContents
        If Coll.Count Then
            With .Offset(1, 1).Resize(UBound(arrOut, 1), UBound(arrOut, 2))
                .Value = arrOut
                .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(2), Order2:=xlAscending, Header:=xlNo
            End With
        End If
    End With
End Sub

وإليك الملف المرفق فيه تطبيق الكود

تقبل تحياتي

 

Transfer Purchases & Sales Using Arrays.rar

[محمود أبوسيف]

والله ما أروعك أخي المبدع أبو البراء

 

[محمود أبوسيف]

أخي أبو البراء لا أعرف كيف أشكرك فالكلمات تهرب مني والله علي ما أقوله شهيد 

فمن فضلك هل من الممكن أن ننتقل إلي الجزء الثاني من المطلوب أم ماذا نفعل ؟

 

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

أخي الحبيب محمود أبو سيف

الحمد لله أن تم المطلوب الأول على خير ...

أفضل دائماً أن يكون كل طلب في موضوع منفصل حتى يتمكن الأخوة الأعضاء من تقديم المساعدة بالشكل الأمثل والذي يحقق الهدف بشكل أسرع

تقبل وافر تقديري واحترامي

[محمود أبوسيف]

أشكرك أخي أبو البراء 

وسوف أتناول المطلوب الثاني في موضوع جديد