تحويل صف الى عمود حسب بيانات عمود اخر

[هاني بدر]

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

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

وشكرا للمساعده

INCOME JV April test.xlsb

[lionheart]

NOT CLEAR AT ALL

[هاني بدر]

لتوضيح الفكره

خلينا ناخدها جز ء جزء كما هو موضح بالمطلوب في عمود AI

وعمود AMINCOME JV April test.xlsb

[lionheart]

Sub Test()
    Dim a, b
    Application.ScreenUpdating = False
        With ActiveSheet
            a = .Range("C4:C43").Value
            CloneArray a, .Range("AV4"), 18, True
            b = Application.Transpose(Range("D3:U3").Value)
            CloneArray b, .Range("AW4"), UBound(a, 1), False
        End With
    Application.ScreenUpdating = True
End Sub

Sub CloneArray(ByVal arr, ByVal rngT As Range, ByVal n As Integer, ByVal allItems As Boolean)
    Dim i As Long, ii As Long, k As Long
    ReDim b(1 To UBound(arr, 1) * n, 1 To 1)
    If allItems Then
        For i = 1 To n
            For ii = LBound(arr, 1) To UBound(arr, 1)
                k = k + 1
                b(k, 1) = arr(ii, 1)
            Next ii
        Next i
    Else
        For i = LBound(arr, 1) To UBound(arr, 1)
            For ii = 1 To n
                k = k + 1
                b(k, 1) = arr(i, 1)
            Next ii
        Next i
    End If
    rngT.Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[هاني بدر]

عزيزي lionheart

بداية كل الشكر على التفاعل والاهتمام وارجو ان تتحملني للنهاية لاهمية الموضوع للشركات التي تملك فروعا متعدده

عند تطبيق الكود لم تتغير البيانات في اى من العمودين 

AI     and    AM 

ولو حضرتك جربت وحذفت البيانات اللي في العمودين AI     and    AM 

وطبقت الكود ستظل الاعمده المطلوبه خاليه 

[lionheart]

Are you joking

Did you have a look at the code? Please have a look carefully and change the reference of the target cell

[هاني بدر]

Dear lionheart

First of all you have all greetings from me

suppose that the majority of members are not experts 

I already tried to change  variables to get results as i wish 

 and don't forget i asked you to be  patient with me

many thanks for being helpful 

here are what i get and still need your help to end that subject

please check the attached file

 

INCOME JV April test.xlsb

[lionheart]

What happened after changing the variables and what changes did you do exactly

And what about the results of the code

[هاني بدر]

في المرفق في تعليقي السابق

تم تغيير مكان وضع النتائج وكانت كما هو مطلوب تماما  مع تغيير بسيط وهو نقل مكان اسم المطعم الى العمود  BL , وكذلك تغيير مكان اسم الحساب الى العمود AI

ومتبقي فقط عملية التجميع حسب اسم الحساب وحسب توصيفه وحسب اسم المطعم 

[lionheart]

I think you have to show us your tries to solve the problem. Don't wait for others to dl all your work for you

[هاني بدر]

الكود موجود في Shape

اسم المطعم

Dim a, b
    Application.ScreenUpdating = False
        With ActiveSheet
            a = .Range("C4:C43").Value
            CloneArray a, .Range("AI4"), 18, True
            b = Application.Transpose(Range("D3:U3").Value)
            CloneArray b, .Range("AW4"), UBound(a, 1), False
        End With
    Application.ScreenUpdating = True
End Sub
Sub CloneArray(ByVal arr, ByVal rngT As Range, ByVal n As Integer, ByVal allItems As Boolean)
    Dim i As Long, ii As Long, k As Long
    ReDim b(1 To UBound(arr, 1) * n, 1 To 1)
    If allItems Then
        For i = 1 To n
            For ii = LBound(arr, 1) To UBound(arr, 1)
                k = k + 1
                b(k, 1) = arr(ii, 1)
            Next ii
        Next i
    Else
        For i = LBound(arr, 1) To UBound(arr, 1)
            For ii = 1 To n
                k = k + 1
                b(k, 1) = arr(i, 1)
            Next ii
        Next i
    End If
    rngT.Resize(UBound(b, 1), UBound(b, 2)).Value = b
    '============================================
        Range("AD4:AD" & [AI5000].End(xlUp).Row).Value = Range("L2").Value
    Range("BL4:BL" & [AI5000].End(xlUp).Row).Value = Range("AW4:AW" & [AI5000].End(xlUp).Row).Value
    Range("AW4:AW" & [AI5000].End(xlUp).Row).Value = ""
   Range("AJ4:AJ" & [AI5000].End(xlUp).Row).FormulaR1C1 = _
        "=""مبيعات شهر "" & "" ….  ""  & MONTH(R2C10) & ""       لــــــــ "" & R2C3 &""  …  "" &RC[28]"
        Range("AJ4:AJ" & [AI5000].End(xlUp).Row).Value = Range("AJ4:AJ" & [AI5000].End(xlUp).Row).Value
       
      
End Sub

INCOME JV April test.xlsb