تقرير لمجموع الارقام السالبة والارقام الموجبة عن طريق التاريخ

[yara ahmed]

سلام عليكم

عمالقة الاكسيل

بحاجة لمساعدة فى عمل تقرير استدعاء للبيانات الموجبة فى عمود والسالبة فى عمود

بالتاريخ وذلك من خلال قائمة منسدلة باسماء شيتس المصنف مع استثناء الشيتس التى لون التاب لها اخضر

مشكورين ياطيبين

takrir yara23.xlsx

[سليم حاصبيا]

جربي هذا الماكرو

Option Explicit
Dim Main As Worksheet
Dim sh As Worksheet
Dim max_ro%, i%, col, arr(), m%
Dim st$, Ro%, k%, s#, x%, itm
Dim date1 As Date, date2 As Date
'=======================
Sub Initiallize()
 For Each sh In Sheets
 If sh.Name <> "TAkrir" Then
  sh.Range("C5:J500").Interior.ColorIndex = xlNone
 End If
 Next
End Sub

Sub Extract_negative()
Set Main = Sheets("TAkrir")
Main.Range("B3:B8").ClearContents
If Main.Range("B2") = vbNullString Then Exit Sub
If Not IsDate(Main.Range("E3")) Or _
   Not IsDate(Main.Range("F3")) Then Exit Sub

Set sh = Sheets(Main.Range("B2") & "")
date1 = Application.Min(Main.Range("e3:f3"))
date2 = Application.Max(Main.Range("e3:f3"))
ReDim arr(1 To 6)
 For i = 3 To 8
  arr(i - 2) = Main.Cells(i, 1)
 Next
max_ro = sh.Cells(Rows.Count, 1).End(3).Row
k = 3
  For Each itm In arr
   For x = 5 To max_ro
    If sh.Cells(x, 1) >= date1 And sh.Cells(x, 1) <= date2 Then
       If sh.Cells(x, itm) > 0 Then
       sh.Cells(x, itm).Interior.ColorIndex = 35
       End If
     s = s + IIf(sh.Cells(x, itm) < 0, _
      sh.Cells(x, itm), 0)
     End If
    Next x
    Main.Cells(k, 2) = IIf(s = 0, "", s)
    s = 0
    k = k + 1
  Next itm
End Sub
'++++++++++++++++++++++++++++++++++
Sub Extract_Positive()
Set Main = Sheets("TAkrir")
Main.Range("C3:C8").ClearContents
If Main.Range("C2") = vbNullString Then Exit Sub
If Not IsDate(Main.Range("E3")) Or _
   Not IsDate(Main.Range("F3")) Then Exit Sub
Set sh = Sheets(Main.Range("C2") & "")
date1 = Application.Min(Main.Range("e3:f3"))
date2 = Application.Max(Main.Range("e3:f3"))
ReDim arr(1 To 6)
 For i = 3 To 8
  arr(i - 2) = Main.Cells(i, 1)
 Next

max_ro = sh.Cells(Rows.Count, 1).End(3).Row
k = 3
  For Each itm In arr
   For x = 5 To max_ro
    If sh.Cells(x, 1) >= date1 And sh.Cells(x, 1) <= date2 Then
       If sh.Cells(x, itm) < 0 Then
       sh.Cells(x, itm).Interior.ColorIndex = 6
       End If
       s = s + IIf(sh.Cells(x, itm) > 0, _
       sh.Cells(x, itm), 0)
     End If
    Next x
    Main.Cells(k, 3) = IIf(s = 0, "", s)
    s = 0
    k = k + 1
  Next itm
End Sub
'++++++++++++++++++++++++++
Sub Get_all()
Initiallize
Extract_negative
Extract_Positive
End Sub

الملف مرفق

 

takrir yara.xlsm

[yara ahmed]

والله انت محصلتش انت رائع 

كود رائع من شخص رائع ومذهل ومبدع

صادفنى مشكلة لما اختارت من القائمة المنسدلة Oll sheets الكود توقف

عند هذا السطر

Set sh = Sheets(Main.Range("B2") & "")

تسلم لى وما اتحرمش منك ابدااااااااااااااااااااااااااااااااااااااااااااااااا

دكتور واستاذ ورئيس قسم الاكسيل 

مشكور يا جميل

[سليم حاصبيا]

هو صعب جداً حذف Oll sheets من القوائم المنسدلة ؟؟؟؟

اصلاً ضعي الاوراق التي تريدين التعامل معها في القوائم المنسدلة

[yara ahmed]

لم احذف oll shetts

بل اريد عند اختيارها من القائمة المنسدلة ان يستدعى الارقام السالبة والموجبة لكل صفحات العمل

يعنى يكون عندى امكانية اختيار صفحة كما هو الان وكل الصفحات لما اختار ollsheets

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

نفذت الموجود بالملف وفعلا اضغط دبل كليك على خلية التاريخ يظهر الفورم كليندر بس مش بيدرج التاريخ

شغل محترفين 

الف الف شكر من قلبى ليك وكل الدعوات والامنيات لك بسعادة دائمة

takrir_ yara.xlsm

[سليم حاصبيا]

تم معالجة الأمر

فقط استبدال  ollsheets  بـــ  ALL (في القوائم المنسدلة)

takrir yara_with ALL.xlsm

[yara ahmed]

مستر سليم انت رائع انت مدهش انت سكر وعسل وكل الحلويات الى فى الدنيا

اشكرك شكر كبير جدااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا

يارب ما اتحرم منك ابدااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا

ربنا يعزك ويكرمك يارب

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

وشكرا شكرا شكرا شكرا شكرا

[سليم حاصبيا]

50 دقائق مضت, yara ahmed said:

مستر سليم انت رائع انت مدهش انت سكر وعسل وكل الحلويات الى فى الدنيا

اشكرك شكر كبير جدااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا

يارب ما اتحرم منك ابدااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا

ربنا يعزك ويكرمك يارب

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

وشكرا شكرا شكرا شكرا شكرا

ملف الكليندر غير موجدود عندي

[yara ahmed]

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

وعملته لضغط دبل كليك على خانات التاريخ يظهر بس مش بيكتب التاريخ

الففففففففففففففف شكرررررررررررررررررررررررررررررر

يا باشا

takrir_ yara.xlsm

[سليم حاصبيا]

لست انا من وضع الكود لذلك لا اعرف كيفية  التعامل معه

[yara ahmed]

الف الف الف الف شكر رينا يعزك

اخى مع شكرى الجزيل جداااااااااااا جدااااااااااااااااااا

تعبك مشكور ياباشا

[yara ahmed]

مستر سليم حاصبيا

اتقدم بالشكر والامنيات الطيبة لك

المعذرة والسماح

نقلت الكود بملفى ولدى اسماء الشيتس متغيرة عنsh مثلا لدى شيت اسمه datareporrt وهكذا كل الاسماء مختلفة حوالى 44 شيت

توقف الكود فى هذا السطر

       If sh.Cells(x, itm) < 0 Then

عملت stop وتشغيل وقف الكود هنا

Sub Extract_negative()

Main.Range("B3:B8").ClearContents

وعند اختيار ALL

توقف الكود هنا

    For Each itm In a_sh

 

تم تعديل يوليو 17, 2020 بواسطه yara ahmed

[سليم حاصبيا]

منذ ساعه, yara ahmed said:

مستر سليم حاصبيا

اتقدم بالشكر والامنيات الطيبة لك

المعذرة والسماح

نقلت الكود بملفى ولدى اسماء الشيتس متغيرة عنsh مثلا لدى شيت اسمه datareporrt وهكذا كل الاسماء مختلفة حوالى 44 شيت

توقف الكود فى هذا السطر

       If sh.Cells(x, itm) < 0 Then

عملت stop وتشغيل وقف الكود هنا

Sub Extract_negative()

Main.Range("B3:B8").ClearContents

وعند اختيار ALL

توقف الكود هنا

    For Each itm In a_sh

 

كل الشيتات التي يجب ان يتفحصها الماكرو يحب ان بيدأ اسمها بـ  sh   يليه رقم من 1 الى ما تريدين من أرقام

مثلاً   ٍsh100 /....... sh3 / sh2/  sh1 لأن الكود يتعرف على الشيت من خلال اسمها

اذا اردت يمكن تغيير اسماء الشيتات الى  1 datareporrt 2/datareporrt   الح....

و لكن بشرط تغيير هذا الجزء في الكود كما في الصورة (اينما تجدينه)

اقصد في اكثر من مكان 

s

 

[yara ahmed]

اشكرك 

بس فى مشكلة الاسماء الشيتات لا استطيع تغير اسماء الشيتس

وليس كلها بنفس الاسم مشكلة كبيرة 

اشكرك بارك الله فيك مستر سليم الجميل جداااااااا

[سليم حاصبيا]

ماهي اسماء الشيتات المطلوبة؟؟؟

هاتي 4 أو 5 اسماء فقط

[yara ahmed]

اشكرك

data reeport-تقرير اول المدة-تقرير المدة الثانية-DATA-نقدية اول المدة-نقدية بالخزينة-ارباح وخسائر

كل الشكر من القلب

[سليم حاصبيا]

لا ينفع 

يجب ان يكون بين اسماء الشيتات الي يجب ان يتعاطى معها الماكرو  شيء مشترك (MyData1 / Mydata2/....) مثلاً

- لا أنصح بتسمية الشيتات باللغة العربية

[yara ahmed]

مشكور يا مستر يا طيب تعبتك معلش

لا استطيع تغير الاسماء فانا اعمل عليها ولست من صممها وصاحب الشركة هو من صممها

انا وظيفتى استخراج بيانات منها 

سأرجع للطريقة اليدوية الف الف الف الف الف الف شكر من قلبى لك يا غالى تعبتك

ربنا يسعد قلبك دائما

[سليم حاصبيا]

57 دقائق مضت, yara ahmed said:

مشكور يا مستر يا طيب تعبتك معلش

لا استطيع تغير الاسماء فانا اعمل عليها ولست من صممها وصاحب الشركة هو من صممها

انا وظيفتى استخراج بيانات منها 

سأرجع للطريقة اليدوية الف الف الف الف الف الف شكر من قلبى لك يا غالى تعبتك

ربنا يسعد قلبك دائما

هناك طريقة اخرى ربما تكون الحل

1- ضعي اسماء الشيتات التي تريدينها في عامود معين مثلا ( Z1- Z100)  في الشيت  "TAkrir"

2- الخطأ باسماء الشيتات المطلوبة (مسافات ناقصة أو زائدة همزة الألف نفاط الياء الخ....) غير مقبول لأنه يعطي نتيحة حاطئة      من الافضل استعمال  نسخ ولصق 

3- القوائم المنسدلة تأخذ بياناتها من هذا النطاق (لبس بالضرورة كاملاً  فقط لغاية اخر

خلية ربما تكون  Z50 مثلاً)

4 - استبدال هذا الجزء من الكود كما في الصورة (اكثر من مرة موجود هذا الجزء)

5- الانتباه الى " _ " Under Score و قبلها مسافة واحدة فقط في المربع الأزرق بعد كلمة  ,Name.

[yara ahmed]

يسعد وقتك يارب

بص انا تعبتك جدا فى الموضوع ده ولو مفيش امل لا تتعب نفسك اختك متعودة على الشغل اليدوى

الشغل الاوتو تعلمته بعذ التعرف عليكم بالمنتدى ومساعدتكم الكثيرة لنا لا حرمنا منكم ابدا

انا نفذت ما قلته كله

وعند الاختيار من القوائم مثلا اسم شيت يتوقف الكود هنا

       If sh.Cells(x, itm) < 0 Then

وعند اختيار ALL

توقف الكود هنا

If Main.Range("B2") <> "ALL" Then Exit Sub

جزيل وخالص الشكر من القلب