تنسيق بمعادلات

[ابو يحى]

اخوانى الخبراء الاعزاء

ارجوا منكم مساعدتى على تنسيق الملف المرفق باستخدام المعادلات

حيث انى اوضحت فى الملف التقرير المطلوب تنسيقة قبل والشكل المطلوب بعد التنسيق بالمعادلات

ولكم جزيل الشكر

 Report.rar

 

تم تعديل أكتوبر 19, 2015 بواسطه ابو يحيى1

[ابو يحى]

الاخوة الخبراء

مرفق محاولة منى لتنسيق الملف لكن ظهر بها بعض الاخطاء مثل تكرار للصفوف .

وعدم ظهور بعض الصفوف والارقام الاخرى فارجو منكم الاطلاع عليها وتوجيهى للافضل .

بارك الله فيكم وفى علمكم .

Report.rar

تم تعديل أكتوبر 20, 2015 بواسطه ابو يحيى1

[عادل حنفي]

اخيابو يحيى1

انا عملت الموضوع لكن بالكود

ارجو ان يساعدك فقط اضغط علي زر Do It

مع ملاحظة عدم مسح كلمة New

تحياتي

Report.rar

[عادل حنفي]

اخي وهذا تعديل بسيط ليشمل كل المدي

Report.rar

[ابو يحى]

أستاذنا عادل

بارك الله لك وشكراً لك مجهودك الكبير

ولكن يا اخى مازالت المشكلة التى تواجهنى موجودة وهى ظهور اسم أ/احمد فؤاد و أ/خليل حسين فى اكثر من صف "وهو المظلل بالون الاصفر"

والمطلوب ان يكون التقرير الموجود فى المرفق " باللون الاخضر "

Report.rar

 

تم تعديل أكتوبر 21, 2015 بواسطه ابو يحيى1

[عادل حنفي]

اخي جرب المرفق التالي

تحياتي

Report.rar

[ابو يحى]

بارك الله لك يا اخى

وجعل مجهودك العظيم فى ميزان حسناتك .

ولكن يوجد لدى استفسار هل يمكن استخدام هذا مهما كبر حجم التقرير .

 

[عادل حنفي]

ممكن طبعا مع التعديل في المدي

لانك حكمتني في مثالك ببيانات وتحها جدول فعملت الكود غير مفتوح المدي

تحياتي

[ابو يحى]

مشكور اخى

واذا ممكن اخى تحدد لى المدى فى المثال حتى اقوم بالتعديل فيه اذا كان التقرير اكبر

وعذرا لجهلى باكواد الفجوال بيزك .

واكرر شكرى مرة اخرى

تم تعديل أكتوبر 22, 2015 بواسطه ابو يحيى1

[ابو يحى]

معلمينا الكرام 

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

وهل من الممكن أن استخرج النتيجة إلى sheet 2 ؟؟

وجزاكم الله خيراً ،،،

[ابو يحى]

للرفع

[ابو يحى]

الاخوة الافاضل

عذرا ان كنت اثقل عليكم ولكن هذا هو حال طالب العلم .

ارجو التغاضى عن طلباتى السابقة ان كان بها بعض الازعاج .

ولكن لى طلب واحد ارجو اجابتى اليه وهو هل من الممكن أن استخرج النتيجة إلى sheet 2 ؟؟

ولكم جزيل الشكر

 Report.rar

[الـعيدروس]

السلام عليكم

بعد اذن الاستاذ الحبيب عادل حنفي

مجرد اثراء للموضوع حل بطريقة اخرى

جرب الكود التالي

 

Sub Ali_Trq()
Dim Lr As Long, Rw As Long, Rww As Long
Dim Rng_Dp As Range, Rng_D As Range, Rng_Empty As Range
Dim Sh As Worksheet, Sht As Worksheet
'************************************************
' اسم الورقة التي بها الجدول
Set Sh = Sheets("Sheet1")
'************************************************
' اسم الورقة التي تريد بها الجدول بعد الترتيب
Set Sht = Sheets("Sheet2")
'
Application.ScreenUpdating = False
Lr = Split(Sh.UsedRange.Address, "$")(4)
Sh.Range("A1:J" & Lr).Copy
'===========================================
With Sht
 .Range("A1").PasteSpecial xlPasteAll
 .Range("A1").PasteSpecial xlPasteColumnWidths
 .Activate
Set Rng_Dp = .Range("D" & Lr + 1)
Set Rng_Empty = .Range("A" & Lr + 1)
Set Rng_D = .Range("A" & Lr + 1)
For Rw = 2 To Lr
    If Application.CountIf(.Range("D1:D" & Rw), .Range("D" & Rw)) > 1 Then
    Set Rng_Dp = Union(Rng_Dp, .Range("D" & Rw))
    End If
'===========================================
    If IsNumeric(.Cells(Rw, 1)) Then
    If Application.CountIf(.Range("A1:A" & Rw), .Range("A" & Rw)) > 1 Then
    Set Rng_D = Union(Rng_D, .Range("A" & Rw))
    End If
    End If
'===========================================
Next Rw
Rng_Dp.Value = "": Rng_D.Value = ""
Lr = Split(.UsedRange.Address, "$")(4)
For Rww = 2 To Lr
   If .Cells(Rww, 1) = "" Then
    Set Rng_Empty = Union(Rng_Empty, .Range("A" & Rww))
   End If
Next
'===========================================
Rng_Empty.EntireRow.Delete xlShiftUp
.Range("A1:J" & Lr).Borders.Color = 1
Set Rng_Dp = Nothing
Set Rng_Empty = Nothing
Set Rng_D = Nothing
End With
Application.ScreenUpdating = True
End Sub

 

تم تعديل نوفمبر 2, 2015 بواسطه الـعيدروس

[ابو يحى]

شكرا لك استاذنا العيدروس على اهتمامك وسرعة ردك

جارى الان محاولة ادراج الكود فى شيت الاكسل

وجزاك الله خيرا

[ابو يحى]

بالفعل كود اكثر من رائع

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

وجعله الله فى ميزان حسناتك

واكرر شكرى لاستاذنا عادل حنفى على مجهوده جازاه الله خيرا