اذهب الي المحتوي
أوفيسنا

محتاج مساعدة في مشروعي


Ambiguooous
إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

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

عندي مشروع شغال عليه وأحتاج مساعدتكم في عمل التقارير النهائية من هذا العمل .. المشروع عبارة عن :

1- عندي الشيت الرئيسي للتسجيل اليومي (مو شيت وحدة راح تكون أكثر من شيت)  (وراح يكون كل شيت باسم العميل customer1 customer2  الى مالانهاية على حسب عدد العملاء) 

2- شيت summary وهذي الشيت تجمع لي (بشكل عمودي) كل الجداول اللي راح تكون في شيت كل عميل بحيث يخلص العميل الاول ويجي بعده العميل الثاني وبعده الثالث وهكذا 

3- شيت Customers عبارة عن قائمة العملاء اللي ياح يكونوا عندي بالتفاصيل اللي المفروض تقرأ من كل شيت لعميل 

4- شيت Products عبارة عن قائمة من المنتجات اللي اللي عندي بتفاصيلها (الكود ، الاسم ، التصنيف ، السعر) بالاضافة كم المستخدم في كل واحد 

 

اللي احتاجه هو شيت رقم 2 وشيت رقم 3 وشيت رقم 4 كيف أقدر أخلي الشغل فيهم يكون أوتو  .. وش ممكن تكون الأفكار اللي أقدر أستخدمها 

 

شاكر ومقدر لكل واحد يدخل ويضيف أي فكرة حتى لو كانت صغيرة وراح أكون ممنون لأي واحد يقدر يجي معاي وحبة حبة نوصل للي أريده في النهاية 😊

 

المرفق يحاكي المشروع  

My project.xlsx

 

رابط هذا التعليق
شارك

جرب هذا الكود

Option Explicit
Sub get_data()
Application.ScreenUpdating = False
Dim S As Worksheet
Dim Cus As Worksheet
Dim m%: m = 3
Dim R%
Set S = Sheets("Summary")
With S
  .Cells.Clear
     For Each Cus In Sheets
        If Cus.Name Like "Customer" & "#" Then
        R = Cus.Range("B9").CurrentRegion.Rows.Count
        Cus.Range("B9").CurrentRegion.Copy .Cells(m, 1)
         With .Cells(m - 1, 1)
         .Value = Cus.Name
         .Interior.ColorIndex = 6
         End With
          m = m + R + 2
        End If
     Next Cus
  .Range("C:C,D:D,H:H").EntireColumn.Delete
 End With
 Application.ScreenUpdating = True
End Sub

الملف مرفق

 

My project.xlsm

  • Like 1
رابط هذا التعليق
شارك

أخي وأستاذي  سليم حاصبيا الله يعطيك كل الصحة والعافية يارب ويرفع من شانك .. الشغل جدا ممتاز بس عندي كم سؤال لو بغيت أغير في الأعمدة اللي راح تجي مع في التقرير هذا وين أغير بالضبط في الكود ؟ وبالنسبة لأسماء الشيت لو راح أغيرهم لاسم العميل نفسه بدلا من customer1 customer2 وكذا .. كيف الطريقة ووين المفروض أغير في الكود ؟ 

* وبالنسبة ل شيت  Customers وش أسهل طريقة أخليه يقرأ من كل شيت ويأخذ لي المعلومات من الجدول الاصفر في كل شيت ؟

* وبالنسبة ل شيت Products أحتاج أنه يعطيني كل منتج كم المستخدم منه والسعر لكل واحد  ؟

شاكر ومقدر مجهودك وتعبك معاي ياأستاذ سليم 

شباب أهل الخبرة في Pivot Table  كيف ممكن يفيدني في هذا المشروع ؟

رابط هذا التعليق
شارك

سوري بس أنا مو عارف النظام في المنتدى .. الحين تأشر على الموضوع "تمت الاجابة" بينما أنا عندي استفسارات ثانية وطلبات (ذكرت في أصل الموضوع) لسه مش عارف اعملها  !!  اعمل موضوع جديد يعني أو نكمل هنا أو كيف  

رابط هذا التعليق
شارك

  • 2 weeks later...

ماشاء الله تبارك الله عليك  شغل جبار ياأستاذ  

 

بصراحة بديت اشتغل عليه واعمل تست بس مش عارف اكمل (أبي أغير في الأعمدة اللي اسحبهم معاي أو أضيف صفحات زيادة لعملاء جدد) مش عارف بالضبط وين المفروض أعدل .. ممكن تشرح لي وين بالضبط أعدل على الكود  ؟؟؟


 


Option Explicit
Sub get_data()
Application.ScreenUpdating = False
Dim S As Worksheet
Dim Cus As Worksheet
Dim m%: m = 3
Dim R%
Dim ar_sh(1 To 3)
'ÇÖÝ Çáì åÐå ÇáãÕÝæÝÉ ÇáÕÝÍÇÊ ÇáÊí áÇ ÊÑíÏ Çä íÊÚÇØì ãÚåÇ ÇáãÇßÑæ
ar_sh(1) = "Summary": ar_sh(2) = "Customers": ar_sh(3) = "Products"
Set S = Sheets("Summary")
With S
  .Cells.Clear
     For Each Cus In Sheets
     If IsError(Application.Match(Cus.Name, ar_sh, 0)) Then
        R = Cus.Range("B9").CurrentRegion.Rows.Count
        Cus.Range("B9").CurrentRegion.Copy .Cells(m, 1)
         With .Cells(m - 1, 1)
         .Value = Cus.Name
         .Interior.ColorIndex = 6
         End With
          m = m + R + 2
        End If
     Next Cus
  .Range("C:C,D:D,H:H").EntireColumn.Delete
 End With
End Sub


=======================================

Option Explicit
Sub Fil_data()
Application.ScreenUpdating = False
Dim My_sh As Worksheet
Dim Cus As Worksheet
Dim m%: m = 2
Dim col%
Dim ar_sh(1 To 3)

'ÇÖÝ Çáì åÐå ÇáãÕÝæÝÉ ÇáÕÝÍÇÊ ÇáÊí áÇ ÊÑíÏ Çä íÊÚÇØì ãÚåÇ ÇáãÇßÑæ
ar_sh(1) = "Summary": ar_sh(2) = "Customers": ar_sh(3) = "Products"
Set My_sh = Sheets("Customers")
With My_sh
  .Range("a1").CurrentRegion.Offset(1).ClearContents
     For Each Cus In Sheets
     If IsError(Application.Match(Cus.Name, ar_sh, 0)) Then
     col = Cus.Cells(6, Columns.Count).End(1).Column
     .Cells(m, 1).Resize(, col).Value = _
     Cus.Cells(6, 2).Resize(, col).Value
     m = m + 1
        End If
     Next Cus
'  .Range("C:C,D:D,H:H").EntireColumn.Delete
 End With
End Sub
 

وبالنسبة لشيت ال products ماعملنا عليها حاجة  ..  عاوز يجيب لي جميع ال ال products في جميع شيت اللي باسم العملاء ويعطيني المجموع حقهم (sum لكل product) 

رابط هذا التعليق
شارك

  • أفضل إجابة

صباح الثورة من بيروت/صيدا/النبطية/صور /طرابلس .....ومن كل شبر من أرض لبنان الحبيب

ربما ينفذ هذا الماكرو ما تريده

للتحكم بالاعمدة التي لا تريد اظارها يمكن معالجة ذلك من خلال تغيير المعطيات في الكود (ما بين علامات ++++++)

Option Explicit
Sub get_data_new()
Application.ScreenUpdating = False
Dim S As Worksheet
Dim Cus As Worksheet
Dim m%: m = 3
Dim LG
Dim R%
Set S = Sheets("Summary")
With S
  .Cells.Clear
     For Each Cus In Sheets
        If Cus.Name Like "Customer" & "#" Then
        R = Cus.Range("B9").CurrentRegion.Rows.Count
        Cus.Range("B9").CurrentRegion.Copy .Cells(m, 1)
         With .Cells(m - 1, 1)
         .Value = Cus.Name
         .Interior.ColorIndex = 6
         End With
      
       LG = .Cells(Rows.Count, "g").End(3).Row
    With .Cells(LG + 1, 6).Resize(, 2)
     .Columns(1) = "SUM:"
     .Columns(2).Formula = _
      "=SUM(G" & m + 1 & ":G" & LG & ")"
     .Interior.ColorIndex = 3
     .Font.Color = vbWhite
     .Value = .Value
     End With
          m = m + R + 2
        End If
     Next Cus
     '+++++++++++++++++++++++++++++
  .Range("C:C,D:D,H:H").EntireColumn.Delete
     '+++++++++++++++++++++++++++++
     .Range("E:E").NumberFormat = "#,##0"
 End With
 Application.ScreenUpdating = True
End Sub

الملف بعد التعديل

 

My project_SALIM.xlsm

  • Thanks 1
رابط هذا التعليق
شارك

6 ساعات مضت, Ambiguooous said:

image.png.90635b3a295ca051a1b7c55c94e262b0.png

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

رابط هذا التعليق
شارك

الحرف   m  هو رقم الصف الدي ستبدأ به البيانات في صفحة Summary

التسلسل 1     to   3  to   الرقم 3  عدد الصفحات التي يجب على الكود ان لا يتعاطى معها  لاننا  نريد استثناءها من عمل الكود (Summary /ٍCustomers / Products)

R هو عدد الصفوف الممتلئة في كل صفحة ابتداءً من الخلية B9

B9 بداية البيانات في كل صفحة

الرقم 6 يدل على اللون الاصفر

"H:H,D:D, C:C" الأعمدة التي لا حاجة لها(يتم مسحها)

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information