هاني بدر قام بنشر مايو 3, 2022 مشاركة قام بنشر مايو 3, 2022 السلام عليكم ورحمة الله وبركاته في المرفق مطلوب تحويل قيد يوميه من جدول الى شكل اليوميه الفرنسيه وشكرا للمساعده INCOME JV April test.xlsb رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مايو 3, 2022 مشاركة قام بنشر مايو 3, 2022 NOT CLEAR AT ALL رابط هذا التعليق شارك More sharing options...
هاني بدر قام بنشر مايو 3, 2022 الكاتب مشاركة قام بنشر مايو 3, 2022 لتوضيح الفكره خلينا ناخدها جز ء جزء كما هو موضح بالمطلوب في عمود AI وعمود AMINCOME JV April test.xlsb رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مايو 3, 2022 مشاركة قام بنشر مايو 3, 2022 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 2 رابط هذا التعليق شارك More sharing options...
هاني بدر قام بنشر مايو 4, 2022 الكاتب مشاركة قام بنشر مايو 4, 2022 عزيزي lionheart بداية كل الشكر على التفاعل والاهتمام وارجو ان تتحملني للنهاية لاهمية الموضوع للشركات التي تملك فروعا متعدده عند تطبيق الكود لم تتغير البيانات في اى من العمودين AI and AM ولو حضرتك جربت وحذفت البيانات اللي في العمودين AI and AM وطبقت الكود ستظل الاعمده المطلوبه خاليه رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مايو 4, 2022 مشاركة قام بنشر مايو 4, 2022 Are you joking Did you have a look at the code? Please have a look carefully and change the reference of the target cell 1 رابط هذا التعليق شارك More sharing options...
هاني بدر قام بنشر مايو 4, 2022 الكاتب مشاركة قام بنشر مايو 4, 2022 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 رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مايو 4, 2022 مشاركة قام بنشر مايو 4, 2022 What happened after changing the variables and what changes did you do exactly And what about the results of the code 1 رابط هذا التعليق شارك More sharing options...
هاني بدر قام بنشر مايو 4, 2022 الكاتب مشاركة قام بنشر مايو 4, 2022 في المرفق في تعليقي السابق تم تغيير مكان وضع النتائج وكانت كما هو مطلوب تماما مع تغيير بسيط وهو نقل مكان اسم المطعم الى العمود BL , وكذلك تغيير مكان اسم الحساب الى العمود AI ومتبقي فقط عملية التجميع حسب اسم الحساب وحسب توصيفه وحسب اسم المطعم رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مايو 4, 2022 مشاركة قام بنشر مايو 4, 2022 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 رابط هذا التعليق شارك More sharing options...
هاني بدر قام بنشر مايو 4, 2022 الكاتب مشاركة قام بنشر مايو 4, 2022 الكود موجود في 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 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان