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

سليم حاصبيا

أوفيسنا
  • Content Count

    7,593
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    168

سليم حاصبيا last won the day on أغسطس 7

سليم حاصبيا had the most liked content!

السمعه بالموقع

6,678 Excellent

عن العضو سليم حاصبيا

  • الإسم الفعلي
    فريق الموقع
  • تاريخ الميلاد 08 مار, 1985

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    استاذ ثانوي
  • البلد
    beiruth
  • الإهتمامات
    eXCEL

اخر الزوار

10,794 زياره للملف الشخصي
  1. مثال عما أقصده هذا الكود Sub test() Dim sh As Worksheet ActiveWindow.DisplayWorkbookTabs = True For Each sh In Sheets sh.Range("A1") = sh.Name Next ActiveWindow.DisplayWorkbookTabs = False End Sub
  2. كي يعمل الماكرو يجب ان تكون اسماء الصفحات ظاهرة يمكن اظهارها (من خلال الكود نفسه) قبل تنفيذ الماكرو تم اخفائها بعد التنفيذ
  3. 1- تم اضافة صفحة جدبدة باسم SALIM تأخذ بياناتها عشوائياً من الشيت G وذلك كي تبقي الشيت الاساسي على بياناتها دون تغيير 2- لا حاجة لادراح اكثر من 20---30 اسم لأان الماكروالذي يعمل على صف واحد يمكنه العملعلى الالوف 3-البيانات في الصفحة G عشوائية لمعرفة مدى فعالية الماكرو (يمكنك استبدالها من الشيت الاساسي عندك غن طريق النسخ واللصق وزيادتتها الى فدر ما تشاء) 4- جرب هذا الملف في الصفحة SALIM بعد الضغط على الزر Run يظهر عندك ماذا كنت تريد 5 _الكود Option Explicit Sub Salim_Mcro() Dim g As Worksheet Dim S As Worksheet Dim Lg%, Ls%, i%, k%, M%, X, Y Set g = Sheets("g") Set S = Sheets("SALIM") Dim Arr() Lg = g.Cells(Rows.Count, 1).End(3).Row If Lg < 17 Then Exit Sub Ls = S.Cells(Rows.Count, 1).End(3).Row If Ls < 17 Then Ls = 17 S.Range("A17:F" & Ls).ClearContents ReDim Arr(1 To Lg - 16) Dim ST$ Dim oBJ As Object Set oBJ = CreateObject("System.Collections.Sortedlist") For i = 1 To Lg - 16 Arr(i) = Application.Transpose(Sheets("g").Range("A" & i + 16).Resize(, 5)) Arr(i) = Application.Transpose(Arr(i)) ST = Join(Arr(i), "*") Randomize Y = Rnd() oBJ.Add Y, ST Next X = oBJ.Count M = 17 For k = 0 To oBJ.Count - 1 S.Cells(M, 1).Resize(, 5) = Split(oBJ.GetBYINDEX(k), "*") M = M + 1 Next End Sub الملف مرفق HiCham2610.xlsm 1- تم اضافة صفحة جدبدة باسم SALIM تأخذ بياناتها عشوائياً من الشيت G وذلك كي تبقي الشيت الاساسي على بياناتها دون تغيير 2- لا حاجة لادراح اكثر من 20---30 اسم لأان الماكروالذي يعمل على صف واحد يمكنه العملعلى الالوف 3-البيانات في الصفحة G عشوائية لمعرفة مدى فعالية الماكرو (يمكنك استبدالها من الشيت الاساسي عندك غن طريق النسخ واللصق وزيادتتها الى فدر ما تشاء) 4- جرب هذا الملف في الصفحة SALIM بعد الضغط على الزر Run يظهر عندك ماذا كنت تريد 5 _الكود Option Explicit Sub Salim_Mcro() Dim g As Worksheet Dim S As Worksheet Dim Lg%, Ls%, i%, k%, M%, X, Y Set g = Sheets("g") Set S = Sheets("SALIM") Dim Arr() Lg = g.Cells(Rows.Count, 1).End(3).Row If Lg < 17 Then Exit Sub Ls = S.Cells(Rows.Count, 1).End(3).Row If Ls < 17 Then Ls = 17 S.Range("A17:F" & Ls).ClearContents ReDim Arr(1 To Lg - 16) Dim ST$ Dim oBJ As Object Set oBJ = CreateObject("System.Collections.Sortedlist") For i = 1 To Lg - 16 Arr(i) = Application.Transpose(Sheets("g").Range("A" & i + 16).Resize(, 5)) Arr(i) = Application.Transpose(Arr(i)) ST = Join(Arr(i), "*") Randomize Y = Rnd() oBJ.Add Y, ST Next X = oBJ.Count M = 17 For k = 0 To oBJ.Count - 1 S.Cells(M, 1).Resize(, 5) = Split(oBJ.GetBYINDEX(k), "*") M = M + 1 Next End Sub الملف مرفق
  4. ربما كان المطلوب Sub Calcul_For_Me() Dim i%, ALL% Dim Fm1$, Fm2$ Dim st$ ALL = Sheets("Total").Cells(Rows.Count, 1).End(3).Row If ALL < 5 Then Exit Sub With Range("B5:C" & ALL) .ClearContents .Interior.ColorIndex = xlNone End With For i = 5 To ALL st = "ISREF('" & Cells(i, 1) & "'!A1" & ")" If Evaluate(st) Then Fm1 = "=SUM('" & Cells(i, 1) & "'!C6:C21)" Fm2 = "=SUM('" & Cells(i, 1) & "'!D6:D21)" ' Cells(i, 2).Formula = Fm1 ' Cells(i, 3).Formula = Evaluate(Fm2) 'OR for values Only Cells(i, 2) = Evaluate(Fm1) Cells(i, 3) = Evaluate(Fm2) Else Cells(i, 2) = "I cant Find This Sheet: " & _ "" & Cells(i, 1) & "" Cells(i, 2).Interior.ColorIndex = 35 End If Next End Sub الملف مرفق tlayt kamal.xlsm
  5. لا أعرف السبب هل يفعل هذا الشيء في الملف الدي رفعته لك؟؟ اذا كنت لا تريد شيئاً في حال كانت الخلية فارغة ضع هذا الشرط في الكود في المكان المناسب (حسب الصورة)
  6. بهذه الطريقة سوف تضيع صف العناوين تم التعديل على الملف الاساسي لتبدأ البيانات من االصف 11 مع الاحتفاظ بالصف العاشر كعنوان Extra_Filter _ziad.xlsm
  7. من قال لك ان بيدأ جدولك من الصف رقم 10 الماكرو مصمم ان يبدأ عملة من الصف رقم2 لذلك هو يقوم بمسح كل شيي ابتداء من الصف رقم 2 ونزولاُ ومن ضمنهم الصف 10
  8. البرنامج لا يسمح بكتابة اي شيء غي موجود في القائمة المنسدلة كما في الصورة لكتابة اي معادلة على الشيت يجب الابتعاد عن الجدول الأخضر لان الأعمدة من A الى E تحت سيطرة الماكرو وهو يقوم بحذفها ليضع مكانها البيانات الجديدة دع معادلاتك تكون في العامود G و ما بعده في اي صف تريد
  9. الكود يظهر كل البينات اذا كانت الخلية H1 فارغة لا اعرف ما المشكلة عندك
  10. مثال اخر (استعمال الفلتر) وتلوين الأصفار Option Explicit Private Sub CommandButton1_Click() Static t% With CommandButton1 If t Mod 2 = 1 Then show_all .Caption = "اخفاء الأصفار" .BackColor = RGB(0, 176, 0) Else Hide_by_flter .Caption = "اظهار الكل" .BackColor = RGB(255, 0, 0) End If End With t = t + 1 End Sub '++++++++++++++++++++++++++++++++ Sub Hide_by_flter() Dim Rg As Range, ro Dim Hd_rg Set Rg = Range("A1").CurrentRegion ro = Rg.Rows.Count If ro = 1 Then Exit Sub With Rg .Interior.ColorIndex = 35 .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 16 .AutoFilter 2, "=0" .AutoFilter 3, "=0" Set Hd_rg = Range("A2:C" & ro - 1).SpecialCells(12) .AutoFilter Hd_rg.Interior.ColorIndex = 6 Hd_rg.EntireRow.Hidden = True End With Range("A1:c1").Interior.ColorIndex = 40 End Sub '+++++++++++++++++ Sub show_all() Range("A1").CurrentRegion.EntireRow.Hidden = False End Sub abo_has_hide_by_filter.xlsm
×
×
  • اضف...