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

تحويل معادله لكود


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

السادة الخبراء

عندى ملف لجدول الحصص به هذه المعادله هى طفيف لجلب اسم المدرس و اليوم و لكن تجعل الملف تقيل جدا عند التغيير

=IFERROR(INDEX(Data2;MATCH(BL7;Day;0);MATCH($B$6;$B$6:$G$6;0));"")

فها ممكن تحويلها لكود

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

مرفق ملف العمل

جدوب حصص.rar

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

السلام عليكم ورحمة اللة وبركاتة

كل عام وانتم بخير .... رمضان كريم

 

تفضل جدوب حصص.xlsm

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

Sub Formula_data()
Dim dataWS As Worksheet
Dim ST1 As String, ST2 As String
Set dataWS = Worksheets("جدول توزيع الحصص")
Application.ScreenUpdating = False

ST1 = Replace("=IFERROR(INDEX(Data2,MATCH(RC[51],Day,0),MATCH(R6C2,R6C2:R6C7,0)),"""")", _
                        "dataWS", "'" & dataWS.Name & "'")
                        
ST2 = Replace("=IFERROR(INDEX(Data2,MATCH(RC[51],Day,0),MATCH(R6C6,R6C2:R6C7,0)),"""")", _
                        "dataWS", "'" & dataWS.Name & "'")
                        
With dataWS.Range("H7:H" & Range("B" & Rows.Count).End(3).Row)
    .Formula = "=CONCATENATE(C7, D7,""."",G7)"
    .Value = .Value
    
For st3 = 7 To 94 Step 2
  dataWS.Range(Cells(st3, "M"), dataWS.Cells(st3, "BE")).Formula = ST1
  dataWS.Range(Cells(st3 + 1, "M"), dataWS.Cells(st3 + 1, "BE")).Formula = ST2
   Next st3
   
End With
With dataWS.Range("m7:be" & Range("L" & Rows.Count).End(3).Row)
 .Value = .Value
End With
End Sub

 

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

اشكر حضرتكم استاذ محمد يوسف و استاذ محمد هشام

ولكنى نسيت اوضح ان يوجد معادله اخرى 

=IFERROR(INDEX(Data2;MATCH(BL8;Day;0);MATCH($F$6;$B$6:$G$6;0));"")

لان المعادله فى M7 - M8 مرتبطين مع بعض

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

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

منذ ساعه, خالد الشاعر said:

اشكر حضرتكم استاذ محمد يوسف و استاذ محمد هشام

ولكنى نسيت اوضح ان يوجد معادله اخرى 

=IFERROR(INDEX(Data2;MATCH(BL8;Day;0);MATCH($F$6;$B$6:$G$6;0));"")

لان المعادله فى M7 - M8 مرتبطين مع بعض

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

 

تم شرح الكود  لتسهيل فهمة

 

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

Private Sub Workbook_SheetChange(ByVal SH As Object, ByVal Target As Range)
    CL = Target.Column
    RW = Target.Row
    If CL = 12 Then
    If Target > "" Then
    Application.ScreenUpdating = False
    Cells(RW, 13).Resize(, 57) = "=IFERROR(INDEX(Data2,MATCH(R7C64,Day,0),MATCH(R6C2,R6C2:R6C7,0)),"""")" '''''هنا حدد العمود المراد وضع الدالة في  وهو همود رقم 13 الي عمود رقم 57
    Cells(RW + 1, 13).Resize(, 57) = "=IFERROR(INDEX(Data2,MATCH(R8C64,Day,0),MATCH(R6C6,R6C2:R6C7,0)),"""")" '''''هنا حدد العمود المراد وضع الدالة في  وهو همود رقم 13 الي عمود رقم 57
    Cells(RW, 59) = "=SUM(45-COUNTIF(RC[-46]:RC[-2],""=0""))" '''    في عمود رقم 59 يتم وضع المعادلة
    Cells(RW, 13).Resize(RW + 1, 59).Value = Cells(RW, 13).Resize(RW + 1, 59).Value '''''هنا يتم تحويل المعادلة الي قيم
    Application.ScreenUpdating = True
    Else
    Cells(RW, 13).Resize(RW + 1, 59).Value = "" ''هنا اذ العمود 12 يساوي فراغ  فباقي الالعمدان تساوي فراغ
    End If
    End If
   End Sub

 

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

استاذ Mohamed Hicham

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

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

فاليوم الذى تم الانتهاء منه لا يرجع له

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

 

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

يجب أولا أخي تنظيم الملف وحذف ارتباطات القوائم المنسدلة وتصحيحها  ليسهل فهم المطلوب .مع توضيح اسم أو رقم العمود الذي يتم بموجبه تنفيذ الكود. 

السؤال ما دور الجدول الموجود يسار ورقة العمل ؟

 

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

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