نقل محتوى خليه بمعلوميه كميه

[حسنى سامى محمد]

HH.xlsx

السلام عليكم فضلا مع وافر الشكر مساعدتى بالملف الملف عباره عن (شيت العقود ) نقل الاكواد من الشيت mp1 صف واحد المطلوب - هل ممكن نقل الكود ال الكميه فيه بالحجز ( D)اقل من كميه امر البيع( C) فقط او - نقل الكود فقط ال الكميه بالفرق (E)  اكبر من الصفر  فقط

[lionheart]

Sub Test()
    Dim arr, v1, v2, coll As New Collection, s As String, max As Long, i As Long, j As Long
    Application.ScreenUpdating = False
        arr = Sheets("MP1").Range("A1").CurrentRegion.Value
        For i = 1 To UBound(arr, 1)
            s = CStr(arr(i, 1))
            On Error Resume Next
                coll.Add Key:=s, Item:=New Collection
            On Error GoTo 0
            If coll(s).Count = 0 Then coll(s).Add s
            If arr(i, 5) > 0 Then coll(s).Add CStr(arr(i, 2))
        Next i
        For Each v1 In coll
            If v1.Count > max Then max = v1.Count
        Next v1
        ReDim arr(1 To coll.Count, 1 To max)
        i = 0
        For Each v1 In coll
            i = i + 1
            j = 0
            For Each v2 In v1
                j = j + 1
                arr(i, j) = v2
            Next v2
        Next v1
        For j = 2 To max
            arr(1, j) = j - 1
        Next j
        With Sheets("Result").Range("A1")
            .CurrentRegion.Clear
            .Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
            With .CurrentRegion
                .EntireColumn.AutoFit
                .Borders.Value = 1
            End With
        End With
    Application.ScreenUpdating = True
End Sub

 

Create a worksheet and name it "Result" first before running the code

[حسنى سامى محمد]

الف شكر استاذنا عمل رائع 

[حسنى سامى محمد]

فضلا @lionhart50

فى حال

- تغير الكميات  بامر البيع تصل الى 60  هل يتاثر الكود 

- ايضا عمود الفرق لو اختلف مكانه 

شاكر ومقدر

العقد	الكود	كميه امر البيع	الحجز	الفرق
BD21-191	1022	2	1	2

[lionheart]

If arr(i, 5) > 0 Then coll(s).Add CStr(arr(i, 2))

This line the number 5 refers to column E and the number 2 refers to column B

[حسنى سامى محمد]

الف شكر يا استاذنا @lionhart50