تحويل المعادلة الى كود

[محمد زيدان2024]

دي معادلة من شيت نتيجةت4 الى شيت نتيجة تقييم41   

=IF(نتيجةت4!F13="";"";IF(نتيجةت4!F13="غ";"لم يتقن المعارف";IF(نتيجةت4!F13="ازرق";"يفوق التوقعات";IF(نتيجةت4!F13="اخضر";"امتلك المعارف والمهارات";IF(نتيجةت4!F13="اصفر";"يحتاج لبعض الدعم";IF(نتيجةت4!F13="احمر";"لم يتقن المعارف"))))))

اريد تحويل المعادلة  الى كود يعمل تلقائي   @محمد هشام.

تحويل الى كود.xlsx

[محمد هشام.]

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

جرب هدا الحل ربما يناسبك

Sub CopyRanges()
Dim i As Long, a As Long, lr As Long
Dim OneRng As Variant, arr As Variant, Irow As Long, C As Long
Dim oldData() As Variant, newData() As Variant
Dim xlnCalcMethod As XlCalculation
Dim WS As Worksheet: Set WS = Sheets("نتيجةت4")
Dim f As Worksheet: Set f = Sheets("نتيجة تقييم41")
 
 Irow = f.Cells.SpecialCells(xlCellTypeLastCell).Row

    oldData = Array("غ", "ازرق", "اخضر", "اصفر", "احمر")
    newData = Array("لم يتقن المعارف", "يفوق التوقعات", "امتلك المعارف والمهارات", "يحتاج لبعض الدعم", "لم يتقن المعارف")
 
    a = WS.Columns("E:AE").Find(What:="*", _
       SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

With Application
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
  
 f.Range("E11:R" & f.Rows.Count).ClearContents
  OneRng = Array("F13:F" & a, "H13:H" & a, "J13:J" & a, "l13:l" & a, "N13:N" & a, "P13:P" & a, _
  "R13:R" & a, "U13:U" & a, "W13:W" & a, "Y13:Y" & a, "AA13:AA" & a, "AC13:AC" & a, "AE13:AE" & a)
   arr = Array("E11", "F11", "G11", "H11", "I11", "J11", "K11", "L11", "M11", "N11", "O11", "P11", "Q11")
For i = 0 To UBound(OneRng)
  WS.Range(OneRng(i)).Copy
   f.Range(arr(i)).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
  Next
lr = f.Columns("E:Q").Find(What:="*", _
    SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
 Set Rng = f.Range("E11:Q" & lr)
    For C = LBound(oldData) To UBound(oldData)
    Rng.Replace oldData(C), newData(C), xlWhole, , , , False, False
  Next
With f.Range("R11:R" & lr)
.Formula = "=IF(" & WS.Name & "!F13="""",""""," & WS.Name & "!AF13)"
    .Value = .Value
    End With

        .Calculation = xlnCalcMethod
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

تحويل الى كود V2.xlsm

تم تعديل يونيو 21, 2024 بواسطه محمد هشام.

[محمد زيدان2024]

شكرا خالص اخي @محمد هشام. بس تعديل على الكود عايز انسخ كمان بيانات من مسلسل الى تاريخ الميلاد من نتيجةت4 الى نتيجة تقييم41

[محمد هشام.]

3 ساعات مضت, محمد زيدان2024 said:

س تعديل على الكود عايز انسخ كمان بيانات من مسلسل الى تاريخ الميلاد من نتيجةت4 الى نتيجة تقييم41

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

'    Sheets("نتيجةت4")اسماء الاعمدة المرغوب ترحيلها 
OneRng = Array("F13:F" & a, "H13:H" & a, "J13:J" & a, "l13:l" & a, "N13:N" & a, "P13:P" & a, _ 
  "R13:R" & a, "U13:U" & a, "W13:W" & a, "Y13:Y" & a, "AA13:AA" & a, "AC13:AC" & a, "AE13:AE" & a, _
                                                               "A13:A" & a) '<=======عمود المسلسل========
  
 ' خلية اللصق  Sheets("نتيجة تقييم41")  
 arr = Array("E11", "F11", "G11", "H11", "I11", "J11", "K11", "L11", "M11", "N11", "O11", "P11", "Q11", _
                                                      "D11")'<=====اول خلية على عمود تاريخ الميلاد========

 

تحويل الى كود V3.xlsm

[محمد زيدان2024]

شكرا اخى الكريم

 

تصحيح.xlsm

تم تعديل يونيو 21, 2024 بواسطه محمد زيدان2024

[محمد هشام.]

يسعدنا اننا استطعنا مساعدتك 

تم تعديل يونيو 21, 2024 بواسطه محمد هشام.

[محمد زيدان2024]

شكرا اخى الكريم مبدع بدرجة فنان  بارك الله فيك وزادكم

[محمد زيدان2024]

10 دقائق مضت, محمد هشام. said:

سعدنا اننا استطعنا مساعدتك 

الشرف لينا اخى الكريم الكلام مش هيوفي حقك والله

[محمد هشام.]

 تفاديا للاخطاء  لا تنسى تغديل السطر الخاص بافراغ البيانات السابقة الى 

f.Range("D11:R" & f.Rows.Count).ClearContents