logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
احمد شريف ali mohamed ali-- لا تميز خلال هذه الفترة YasserKhalil نقل بيانات بشرط اكسيل اسئله واجابات



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




موضوع مغلق


  • تمت الإجابة
29-03-2022 05:14 مساءً
السلام عليكم أساتذتى الكرام ... رجاءاً من حضراتكم مساعدتى فى ايجاد حل لمشكلتى , أريد من سيادتكم تجميع جميع شهور السنة بصفحة Summary , مع العلم ان كل صفحة من صفحات الملف تشمل شهر كامل وسيتم اضافة باقى شهور السنة مستقبلا وذلك طبعاً بدون تكرار اسم المورد الموجود بالعمود B مقترناً بإسم الرحلة الموجود بالعمود C على ان يذكرا مرة واحدة ولكن بإجمالى المبالغ... وسأضع مثال فعلى للنتيجة المطلوبة بصفحة Summary ولكم جزيل الشكر وبارك الله فى جهودكم
ERoGP_Untitled Total Suppliers Invoice - Copy.xlsm
 
 
  Total Suppliers Invoice - Copy.xlsm   تحميل xlsm مرات التحميل :(6)
الحجم :(64.68) KB





look/images/icons/i1.gif تجميع وترصيد جميع صفحات الملف بصفحة واحدة بدون تكرار
  01-04-2022 11:58 مساءً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 227
رصيد العضو : 0
الجنس :
الدعوات : 4
قوة السمعة : 2153
الاعجاب : 22
السلام عليكم ورحمة الله
كل عام و انتم بخير
الله اعلم ان كنت فهمت ما تريده كما تقصد ام لا
الكود الاول لجلب اسماء العملاء بدون تكرار و يم ربطه بزر التنفيذ
يمكنك التعديل على الكود لاضافة مزيد من الشهور
CODE
Sub GetNames()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long, C As Range
Dim LS As Long, p As Long, Obj As Object
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(3).Row
Sh.Range("B3:B" & LS) = ""
Set Obj = CreateObject("scripting.dictionary")
For Each ws In Worksheets(Array("January", "February", "March"))
If ws.Name <> Sh.Name Then
LR = ws.Range("B" & Rows.Count).End(3).Row - 1
For Each C In ws.Range("B3:B" & LR)
If Not IsEmpty(C) Then Obj(C & "") = ""
Next
End If
Next
Sh.Range("B3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys)
Call SumIf_Valus
End Sub


الكود الثانى و هو مربوط بالكود الاول و لا يتم تنفيذه منفردا
CODE
Sub SumIf_Valus()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long
Dim Arc As Variant, Arr As Variant
Dim LS As Long, j As Long, x As Double
Dim SupNam As String
Application.ScreenUpdating = False
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(3).Row
If LS < 3 Then LS = 3
Arc = Array("D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
Arr = Array("G", "H", "I", "J", "K", "L", "M", "N", "P", "Q")
j = 3
Do While j <= LS
SupNam = Sh.Range("B" & j)
For i = LBound(Arr) To UBound(Arr)
For Each ws In Worksheets(Array("January", "February", "March"))
LR = ws.Range("B" & Rows.Count).End(3).Row
If LR < 3 Then LR = 3
x = x + WorksheetFunction.SumIf(ws.Range("B3:B" & LR), SupNam, _
ws.Range(ws.Cells(3, Arr(i)), ws.Cells(LR, Arr(i))))
Sh.Range(Arc(i) & j) = x
Next
x = 0
Next
j = j + 1
Loop
Application.ScreenUpdating = True
End Sub


أثارت هذه المشاركة إعجاب: هانى على، ali mohamed ali، hassona229،






الكلمات الدلالية
تجميع ، وترصيد ، جميع ، صفحات ، الملف ، بصفحة ، واحدة ، بدون ، تكرار ،









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

الساعة الآن 06:24 PM