أكاديمية الصقر للتدريب

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


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





تقرير لتوضيح البيانات

السلام عليكم اتمنى اجد ما ابغى اساتذة المنتدى وان يتسع صدركم لنا ونحن اخواتكن لدى عدد من الشيتس بكل شيت عدد 28 عمود كل ش ..


موضوع مغلق

الصفحة 1 من 3 < 1 2 3 > الأخيرة »


12-07-2020 11:26 مساء
yara ahmed
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 07-07-2020
رقم العضوية : 19921
المشاركات : 24
الجنس : أنثى
يتابعهم : 1
يتابعونه : 1
قوة السمعة : 64
 offline 

السلام عليكم
اتمنى اجد ما ابغى اساتذة المنتدى وان يتسع صدركم لنا ونحن اخواتكن
لدى عدد من الشيتس بكل شيت عدد 28 عمود كل شيت له اسم
احتاج تقرير توضيحى لايجاد القيم بداخله
مشكورين يا طيبين
 
 
  استدعاء شيتس.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(19.379) KB


13-07-2020 06:18 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تقرير لتوضيح البيانات
وعليكم السلام أختي الكريمة 
لا ننسى أن الهدف من المنتدى تعليمي ، وأنا لا أحبذ الحلول الجاهزة بدون شرح كافي لكل سطر في أسطر الكود ، حتى يرتقي مستواكي وتتطورين ، ومن ثم تفيدين نفسك وغيرك
سأحاول تبسيط الموضوع لكي في خطوات
** الخطوة الأولى: حسب الملف المرفق لديك ورقة عمل أساسية وهي الورقة المطلوب تجميع البيانات بها ، وسنضع لها متغير ونسميه sh .. حيث يتم تعيين ورقة العمل Come لتعبر عن هذا المتغير
وفي بداية الكود لتسريع الكود يتم إيقاف اهتزاز الشاشة وهذا يسرع الكود قليلاً
ونقوم بالإعلان عن متغير من النوع Worksheet باسم ws ، وهذا سنستخدمه في عمل حلقة تكرارية حول أوراق العمل بالمصنف
Rem Step 1
Sub Test()
    Dim ws As Worksheet, sh As Worksheet
    Application.ScreenUpdating = False
        Set sh = ThisWorkbook.Worksheets("Come")
        
    Application.ScreenUpdating = True
End Sub

13-07-2020 06:23 صباحا
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تقرير لتوضيح البيانات
الخطوة الثانية: نقوم بعمل حلقة تكرارية لأوراق العمل كلها ونقوم بعمل استثناء لورقة العمل الأساسية التي أشرنا إليها ، ويكون الجزء الخاص بالحلقة التكرارية بهذا الشكل
Rem Step 2
Sub Test()
    Dim ws As Worksheet, sh As Worksheet
    Application.ScreenUpdating = False
        Set sh = ThisWorkbook.Worksheets("Come")
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> sh.Name Then
                Debug.Print ws.Name
            End If
        Next ws
    Application.ScreenUpdating = True
End Sub

حيث تم استخدام الجملة الشرطية للتحقق من اسم ورقة العمل ، فإذا كان اسم ورقة العمل لا يساوي اسم ورقة العمل الأساسية ، يتم تنفيذ الأسطر بين جملتي الشرط If .. End If 
وهنا سطر واحد ، حيث سنضيف لاحقاً الأسطر التي تساعدنا في تحقيق المطلوب ، والسطر هنا يطبع اسم ورقة العمل في النافذة الفورية ، ويستحب استخدام مثل هذه الأوامر Debug.Print من أجل متابعة تنفيذ الكود قبل المضي في كتابة بقية الأسطر
لإظهار النافذة الفورية اضغطي Ctrl + G أو من قائمة View اختاري Immediate Window
وبعد تنفيذ الكود سنجد أن أسماء أوراق العمل كلها تمت طباعتها في النافذة الفورية ما عدا ورقة العمل الأساسية Come التي قمنا بعمل استثناء لها.

13-07-2020 06:31 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تقرير لتوضيح البيانات
الخطوة الثالثة: بما أن الأعمدة في ورقة العمل الأساسية والمطلوب تجميع البيانات فيها تأتي متتابعة ، يمكننا هنا استخدام متغير وليكن باسم c من النوع Long ليعبر عن العمود الذي سنضع فيه البيانات
سنقوم بوضع قيمة مبدئية للعمود وهي 10 ، والرقم 10 ليس برقم عشوائي إنما هو رقم أول عمود سيتم جلب البيانات إليه وهو العمود J .. ويكون الكود بهذا الشكل بعد الإضافة للمتغير الذي سنستخدمه ليعبر عن العمود الهدف
ويلزم أن يتم تغيير رقم العمود في نهاية كل حلقة تكرارية لأوراق العمل ، لذا نستخدم معادلة رياضية بسيط وهي أن المتغير يساوي قيمة المتغير نفسه مضاف إليه 1
قبل تنفيذ الكود قومي بمسح محتويات النافذة الفورية ، ثم نفذي الكود ولاحظي قيمة المتغير c (المعبر عن رقم العمود الهدف) مع كل حلقة تكرارية
Rem Step 3
Sub Test()
    Dim ws As Worksheet, sh As Worksheet, c As Long
    Application.ScreenUpdating = False
        Set sh = ThisWorkbook.Worksheets("Come")
        c = 10
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> sh.Name Then
                Debug.Print c
                c = c + 1
            End If
        Next ws
    Application.ScreenUpdating = True
End Sub


نلاحظ النتائج في النافذة الفورية هي 10 و 11 و 12 و 13 و 14 و 15 وهي أرقام الأعمدة التي سيتم وضع البيانات بها

13-07-2020 06:48 صباحا
مشاهدة مشاركة منفردة [4]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تقرير لتوضيح البيانات
الخطوة الرابعة: بما أن النطاق المطلوب نسخ بياناته في أورق العمل ثابت وهو يبدأ من الخلية E5 وينتهي بالخلية W5 ، سنقوم بوضع سطر يقوم بنسخ النطاق ، ولنقوم بعملية النسخ نشير لورقة العمل المطلوب نسخ البيانات منها ، وستكون الإشارة واحدة لجميع أوراق العمل ، حيث تم استخدام المتغير ws ليعبر عن ورقة العمل في الحلقة التكرارية ، وبالطبع كما شرحنا فإن المتغير ws سيتغير في كل حلقة تكرارية
ws.Range("E5:W5").Copy

كما تلاحظين السطر في منتهى البساطة .. إشارة لورقة العمل ، يليها إشارة للنطاق ، يليها ما نريد فعله بالنطاق وهو هنا أن نقوم بنسخ النطاق
النطاق هنا في صف واحد والمطلوب عند وضع البيانات أن تكون البيانات رأسية وليس أفقية كما هو موجود في أوراق العمل وهنا يمكننا استخدام اللصق الخاص ، ونستخدم Transpose
ويمكن تسجيل ماكرو بهذه الخطوة لمعرفة كيف يتم النسخ من الصف ليكون كعمود
>> بشكل يدوي نقوم بنسخ النطاق ثم تحديد أي خلية ، ونقوم بعمل كليك يمين على الخلية ثم Paste Special ثم نحدد الخيارات كما بالصورة
NjxEc_001

نعود للكود ..
المطلوب الآن لصق البيانات التي تم نسخها من السطر السابق ، لذا أول خطوة هنا هو تحديد الخلية الهدف التي سيتم لصق البيانات بها
والخلية ستكون في ورقة العمل الأساسية لذا نقوم بوضع إشارة لورقة العمل الأساسية وهي sh ، يليها الخلية الهدف وللإشارة للخلية يمكن استخدام Cells وهذه تستخدم للإشارة للخلية باستخدام رقم الصف يليه رقم العمود
بما أن رقم الصف المطلوب لصق البيانات فيه هو الصف رقم 6 ، والعمود سيكون رقمه متغير حسب الحلقة التكرارية وكما وضحنا (المتغير c)
إذاً ستكون الإشارة بهذا الشكل
sh.Cells(6,c).

بعد أن أشرنا لورقة العمل الهدف والخلية الهدف .. يأتي السؤال: ماذا نريد أن نفعل بتلك الخلية؟
الإجابة نقوم بعمل لصق خاص ونستخدم الأمر PasteSpecial ، ولهذا الأمر عدة بارامترات ، لن نحتاج إلا إلى اثنين منهم
البارامتر الأول وهو
Paste:=xlPasteValues

وهو خاص باللصق الخاص
والبارامتر الثاني وهو تحويل البيانات من شكل أفقي لشكل رأسي ويكون بهذا الشكل
Transpose:=True


المهم في نهاية المطاف سيكون السطر بهذا الشكل
sh.Cells(6, c).PasteSpecial Paste:=xlPasteValues, Transpose:=True


وها هو الكود في شكله النهائي
Rem Step 4
Sub Test()
    Dim ws As Worksheet, sh As Worksheet, c As Long
    Application.ScreenUpdating = False
        Set sh = ThisWorkbook.Worksheets("Come")
        c = 10
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> sh.Name Then
                ws.Range("E5:W5").Copy
                sh.Cells(6, c).PasteSpecial Paste:=xlPasteValues, Transpose:=True
                c = c + 1
            End If
        Next ws
    Application.ScreenUpdating = True
End Sub


 
 
 


13-07-2020 07:17 صباحا
مشاهدة مشاركة منفردة [5]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تقرير لتوضيح البيانات
 1-كل شيء متغير في اي جدول في الاكسل يجب ان يكون مستقلاً     عن باقي  البيانات (اسلوب عملي في الأكواد)
  ( فوقه واسفله صفوف فارغة  /  عن يمينه ويساره اعمدة فارغة)
2-لهذه الغاية تم ادرج صفين فارغين (الصف رقم 26 و الصف رقم 6)
   ( مخفيين) و تفريغ العامود "D" (أيضاً محفي)
3- الكود

Option Explicit
Sub All_in_One()

Dim sh As Worksheet
Dim Co As Worksheet
Dim m As Byte
m = 5
Set Co = Sheets("Come")
Co.Range("E7").CurrentRegion.ClearContents
For Each sh In Sheets
 If sh.Name <> Co.Name Then
  sh.Cells(5, 5).Resize(, 19).Copy
  Co.Cells(7, m).PasteSpecial , _
  Paste:=xlPasteValues, Transpose:=True
  m = m + 1
End If
Next
Application.CutCopyMode = False
Co.Range("C5").Select
End Sub

الملف مرفق

 
 
 
  My_data_Yara.xlsm   تحميل xlsm مرات التحميل :(1)
الحجم :(37.586) KB


13-07-2020 07:42 صباحا
مشاهدة مشاركة منفردة [6]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تقرير لتوضيح البيانات
بارك الله فيك أخي الحبيب سليم وجزاك الله خيراً


الصفحة 1 من 3 < 1 2 3 > الأخيرة »


الكلمات الدلالية
البيانات ، لتوضيح ، تقرير ،


 










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

الساعة الآن 08:19 صباحا