اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

طلب كود للبحت


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

الاخ الكريم / جمعة محمد محمد

بارك الله فيك

شاهد المرفق التالي

ارجو ان يفي بطلبك

 

210-SAMA.rar

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

السلام عليكم

الاستاذ الحبيب / أبو حنين

بارك الله فيك

كود متقن وذكي وبه افكار راائعة

وعذرا حيث كنت اقوم بوضع الكود لتنفيذ طلب الاخ / جمعه

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

حيث انه من الاكيد ان بعد ردكم لا يوجد رد آخر يضاهيه

تقبل خالص تحياتي

تلميذك

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

ما شاء الله عليكم

أخى فى الله 

الأستاذ الكبير/ حماده عمر

 

بارك الله فيكم

وتقبلوا منى وافر الإحترام والتقدير

تم تعديل بواسطه محمود_الشريف
رابط هذا التعليق
شارك

السلام عليكم

الاخ الحبيب / محمود_الشريف

بارك الله فيك

تقبل خالص تحياتي

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

السلام عليكم

جزاك الله خيرا أخي : محمود الشريف

********************************************************

شرح الكود :

هذا السطر فيه التصريح بالمتغيرات

Dim lr As Long, Last As Long, Last1 As Long, i As Long

هذا السطر معناه اذا كان مربع البحث فارغا فلا تعمل اي شيئ

If TextBox1 = "" Then Exit Sub

هذا السطر لمنع اهتزاز الشاشة

Application.ScreenUpdating = False

هذا السطر لمعرفة آخر خلية تحتوي على بيانات

lr = Cells(Rows.Count, "C").End(xlUp).Row + 1

هذا السطر معناه  اننا سنقوم باسناد بعض الاشياء للنطاق الذي يحتوي على بيانات

With Range("B6:D" & lr)

الاشياء التي اسندناها هي :

1

مسح المحتوي

.ClearContents

2

مسح الاطارات

.Borders.Value = 0

3

جعل الخط عادي وليس سميك

.Font.Bold = False

4

حجم الخط =11

.Font.Size = 11

5

الخلفية بدون لون

.Interior.ColorIndex = 0

6

تنسيق الخلايا عام

.NumberFormat = "General"

نهاية الاسناد

End With

*******************************************************************************

تعيين آخر خلية مكتوبة في صفحة البيانات

Last = Sheets("AAA").Cells(Rows.Count, "C").End(xlUp).Row

تعيين رقم الصف الذي ستنقل اليه البيانات

x = 6

انظر في الخلايا من أول خلية الى آخر خلية مكتوبة

For i = 1 To Last

اذا كانت الخلية في العمود الرابع تساوي ما هو مكتوب في مربع النص و بعدها بخليتين لا تساوي الحرف  : غ

If Sheets("AAA").Cells(i, 4).Value = TextBox1.Text And Sheets("AAA").Cells(i, 4).Offset(0, 2) <> "غ" Then

قم بنسخ العمود الثالث و الخامس والسادس

 Union(Sheets("AAA").Range("C" & i), Sheets("AAA").Range("E" & i), Sheets("AAA").Range("F" & i)).Copy

قم بالصق ابتداءا من الصف السادس

Range("B" & x).PasteSpecial xlPasteValues

ثم ارسم الاطار لكل خلية

Range("B6:D" & x).Borders.Value = 1

و اكتب كلمة الاجمالي في الاخير

 Range("B" & x + 1) = "الاجمـــــــالي"

و اجمع ما هو موجود في العمود :  C

Range("C" & x + 1) = Application.WorksheetFunction.Sum(Range("C6:C" & x))

ارسم اطار الكلمة اجمالي و المجموع

Range("B" & x + 1).Borders.Value = 1
 Range("C" & x + 1).Borders.Value = 1

اكمل باقي الخلايا

x = x + 1

نهاية الشرط

End If

اكمل

Next

*****************************************************************************************

الجزئية التالية للتنسيق

Last1 = Cells(Rows.Count, "C").End(xlUp).Row
If Last1 < 6 Then Exit Sub
 With Range("B" & Last1 & ":" & "C" & Last1)
.Font.Bold = True: .Font.Size = 14: .Interior.ColorIndex = 43: .NumberFormat = "#,##0"
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False

و السلام عليكم

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

السلام عليكم

الاستاذ الحبيب / أبو حنين

بارك الله فيك

دائما تقدم اسلوب السهل الممتنع في الاكواد

والآن تقدم نفس الاسلوب في شرح الاكواد ... شرح اكثر من راائع ووافي

زادك الله من فضله ومن علمه استاذي الحبيب

تقبل خالص تحياتي

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

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