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

تحديد الخلايا التى تحوى معادلات ذات قيم خاطئة


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

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

أقدم لكم اخوتى الأفاضل كودا يقوم بفحص نطاق من الخلايا ويحدد فقط الخلايا التى تحوى معادلات ذات  القيم الخاطئة ويميزها بالتلوين أو التعديل

أو التفريغ أو بعمل فلاش لتلك الخلايا  لك الخيار فى اختيار شكل التمييز المناسب  

الكود وعليه شرح بعض السطور :

Option Explicit
Private Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName _
As String, ByVal uFlags As Long) As Long

Sub CheckRangeForError()

' by mokhtat 2/10/2015
' Error values include #DIV/0!, #N/A, #NAME?, #NULL!, #NUM!, #REF!, and #VALUE!.

Dim C As Range
Dim i As Integer
Dim PlaySound As Boolean
                                                       
' تحديد نطاق الفحص
Sheets("Sheet1").Range("A2:F20").Select
' تحديد الخلايا التى تتضمن أخطاء
Selection.SpecialCells(xlCellTypeFormulas, 16).Select 
' استدعاء صوت من أصوات الويندوز للتنبيه على انتهاء الفحص
PlaySound = True
If PlaySound Then
    Call sndPlaySound32("C:\windows\media\notify.wav", 1)   ' حدد الصوت المفضل لك طبقاً للمسار المقابل
End If
' رسالة الى المستخدم بسؤال عن الرغبة فى التمييز أم لا
If MsgBox("  تم انتهاء الفحص , هل تريد تمييز الخلايا ؟ ", vbYesNo + vbQuestion) = vbNo Then
  
  Exit Sub                                             ' فى حالة اختيار لا    يتم الخروج من الاجراء
  Else        ' فى حالة اختيار تعم  يتم عمل تمييز للخلايا بالتفريغ أو بالتعديل أو التلوين أو الفلاش
    
    ' ------------------------------------------------------------
    '     تمييز الخلايا التى بها اخطاء  بالتعديل
    ' For Each C In Sheets("Sheet1").Range("A2:F20")
    '    If IsError(C.Value) Then
    '       C.Value = "معادلة خاطئة"
    '    End If
    ' Next C
    '-------------------------------------------------------------
    '     تمييز الخلايا التى بها اخطاء  بالتفريغ
    ' For Each C In Sheets("Sheet1").Range("A2:F20")
    '    If IsError(C.Value) Then
    '       C.Value = ""
    '    End If
    ' Next C
    '-------------------------------------------------------------
    '     تمييز الخلايا التى بها اخطاء  بالتلوين
    ' For Each C In Sheets("Sheet1").Range("A2:F20")
    '    If IsError(C.Value) Then
    '     C.Interior.ColorIndex = 3
    '   End If
    ' Next C
    '-------------------------------------------------------------
    '    تمييز الخلايا التى بها اخطاء  بالفلاش
      For Each C In Sheets("Sheet1").Range("A2:F20")
        If IsError(C.Value) Then
           C.Select
               With C
                 For i = 1 To 2  ' عدد مرات الوميض
                   Application.Wait (Now + TimeValue("0:00:01")) ' انتظار مؤقت  لمدة ثانية
                     .Interior.ColorIndex = 6
                       Application.Wait (Now + TimeValue("0:00:01"))
                     .Interior.ColorIndex = 7
                    Next
                 .Interior.ColorIndex = xlNone
              .Font.Color = -16777024
             End With
         End If
     Next
    '------------------------------------------------------------
End If

End Sub




تفضلوا المرفق وتقبلوا تحياتى

select all cells if contains Error value .rar

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

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

و أخيرًا أصبح بإمكاننا عمل سكانير لخلايانا .. طبعًا ليست العصبيّة .. و إنّما الاكسيليّة .

كود أكثر من رائع .. بارك الله فيك أستاذنا الغالي مختار حسين محمود .. جزاك الله خيرًا وزادها بميزان حسناتك .. يا رب

                                                                                        فائق احتراماتي

560f118e38fb1___.thumb.gif.f1d59b740b5ee

 

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

أخي الغالي المتميز مختار

يعجبني أسلوبك في التعامل مع الأكواد ..أسلوب جديد ومميز ورائع

جزيت خيراً على الموضوع الرائع والذي يستحق منا أن نصفق له بحرارة :clapping:

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

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

أستاذى الفاضل عادل حنفى

بارك الله فيك ، سلمت من كل شر ، شرفنى مرورك أستاذى الكريم  

أخى العزيز زيزو البسكرى 

                           بارك الله فيك  دائما تشرفنى بمرورك العزيز

أخى وأستاذى الغالى ياسر خليل

أشكرك بحرارة على هذا التشجيع الدائم والمستمر  وهذا ما تعلمته من المنتدى ومنك تحديداً أستاذى الفاضل

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

أخى الحبيب ياسر فتحى

بارك الله فيك ، سلمت من كل شر ، يشرفنى مرورك وتشجيعك الدائم يا بش مهندس

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

السلام عليكم

استاذ مختار

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

واستغل هذه الفرصه للاساتذة الافاضل ان يقومو مشكورين عند وضع كود بشرحه حتى يتسنا لنا فهم الكود والتعديل عليه وتوفير وقت وجهد الشخص الذي يريد المساعدة ........فلا تحرمونا من شرح  الاكود .....

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

السلام عليكم

بارك الله فيك أخى الحبيب محمد 

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

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

كود جميل للاستاد الفاضل مختار حسين

عند بعض الملاحظات

1- من الأفضل اضافة  Error Handling  للكود لتفادي ال  RunTime error  في حالة عدم وجود أي خلايا تحتوي على معادلات في الصفحة

2- يمكن الاستغناء عن  Select  ليكون الكود أسرع

3- في حالة وجود أكثر من خلية حاوية لمعادلة يمكن اشغال الوميض على كل الخلايا مرة واحدة في نفس الوقت .. هدا الأمر من شانه الاسراع بالكود خصوصا لو وجدت خلايا عديدة

4- من الأحسن تغيير شكل الكود بحيث يصبح التعديل و التفريغ و التلوين و الوميض  Arguments  يتم اختيارهم من طرف المستخدم .. هدا من شأنه اعطاء للكود مرونة كبيرة

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

السلام عليكم أخي الأستاذ مختار حسين

جزاك الله خير...عمل متميز أرجو أن يدخل حيز التنفيذ للدلالة على الأخطاء في مجالات الحياة والعمل، بعد ملاحظات الأستاذ المحترم جعفر

 ما تقدمونه رائع حقاً ..تقبل تحياتي

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

أخى وأستاذى العزيز جعفر   أشكرك بجد على هذا النقد البنّاء فبه نتعلم ونتقدم

لكن هذا ما كان وليس فى الامكان الا ما كان فأنا لم أصل بعد الى هذا المستوى من الحرفية والسرعة فى انشاء الأكواد

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

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

السلام عليكم يا أستادي الفاضل مختار حسين

فعلا نحن كلنا هنا لنتعلم و لهدا نحاول دائما تحسين أعمالنا قدر الامكان ... أنا أعتبر كل سؤال أو مشاركة فرصة للتعلم و لتحسين خبراتنا

اليك هدا التعديل للكود فهو يتحسب مسبقا لأي أخطاء ممكن أن تحدث كما أنه أسرع و أكثر مرونة بسبب ال Enum Argument

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

 

ملف للتحميل : https://app.box.com/s/3tmxv0k3xxzj3fg6616oounfugns55si

الكود في موديول عادي:

Option Explicit

Private Enum ActionToTake
    EditCells = 0
    EmptyCells = 1
    ColorCells = 2
    FlashCells = 4
End Enum

Private Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName _
As String, ByVal uFlags As Long) As Long


Sub test()
    Dim eAction As ActionToTake
    Dim sAction As String
    Dim oTargetRange As Range
    
    Set oTargetRange = Sheet1.Range("A1:K20")
    eAction = FlashCells
    
    Select Case eAction
        Case EditCells
            sAction = "edit"
        Case EmptyCells
            sAction = "clear"
        Case ColorCells
            sAction = "change the color of"
        Case FlashCells
            sAction = "flash"
    End Select
    If MsgBox("You are about to " & sAction & " the cells in the Range : " & vbCr & vbCr & _
    oTargetRange.Address(external:=True) & vbCr & vbCr & "Go ahead ?", vbExclamation + vbYesNo) = vbYes Then
        If CheckRangeForErrors(Target:=oTargetRange, WhichAction:=eAction) = False Then
            MsgBox Err.Description
        End If
    End If
End Sub

Private Function CheckRangeForErrors( _
    ByVal Target As Range, _
    Optional ByVal WhichAction As ActionToTake = FlashCells _
) _
    As Boolean

    Dim oCellsWithErrorFormulae As Range
    Dim oCell As Range
    Dim ar() As Long
    Dim j As Long
    Dim i As Long
    Dim t As Single
    
    On Error Resume Next
    Set oCellsWithErrorFormulae = Target.SpecialCells(xlCellTypeFormulas, 16)
    If Not oCellsWithErrorFormulae Is Nothing Then
        With oCellsWithErrorFormulae
            Select Case WhichAction
                Case EditCells
                    .Value = "Error Edited"
                Case EmptyCells
                    .ClearContents
                Case ColorCells
                    .Interior.Color = vbRed
                Case FlashCells
                    ReDim ar(1 To .Cells.Count)
                    For Each oCell In .Cells
                        i = i + 1
                        ar(i) = oCell.Interior.ColorIndex
                    Next oCell
                    For i = 1 To 4
                        Call sndPlaySound32("C:\windows\media\notify.wav", 1)
                        .Cells.Interior.ColorIndex = 3
                        t = Timer
                        Do
                            DoEvents
                        Loop Until Timer - t >= 0.2
                        j = 0
                        For Each oCell In .Cells
                            j = j + 1
                            oCell.Interior.ColorIndex = ar(j)
                        Next oCell
                        t = Timer
                        Do
                            DoEvents
                        Loop Until Timer - t >= 0.2
                    Next i
                    i = 0
                    For Each oCell In .Cells
                        i = i + 1
                        oCell.Interior.ColorIndex = ar(i)
                    Next oCell
                    Erase ar
                    Set oCellsWithErrorFormulae = Nothing
                    Set oCell = Nothing
            End Select
        End With
        CheckRangeForErrors = True
    End If
End Function


 

تم تعديل بواسطه جعفر الطريبق
  • Like 3
رابط هذا التعليق
شارك

أخى الغالى  جعفر أنت عبقرى بمعنى الكلمة  لكن

 الكود لم يصبح أكثر مرونة  فهو الأن قاصر على الفلاش فقط

المرونة المنشودة هى أن يستطيع المستخدم أن يختار بين اما أن تفرغ المعادلات الخاطئة  أو تلون أو تعطى قيمة معينة أو اشعال الوميض فيها

فيمكن اضافة input box  يدخل فيه المستخدم رقما  1 أو 2 أو 3 أو 4

1 تعمل التفريغ          2   تلون                  3  تعطى قيمة        4 تشعل الوميض       أعتقد أن هذا يعطى مرونة أكثر    أرجو أن تكون الفكرة واضحة 

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

الاستاد الفاضل مختار حسين شكرا على المتابعة

في بداية الماكرو  Test  توجد ال Variable eAction  و ال  Variable oTargetRange ... فالاولى تعطي الكود امكانية اختيار مجال الخلايا و الثانية اختار التلوين أو التفريغ أو الوميض .. تلك هي المرونة التي كنت أقصدها و هي مرونة على مستوى الكود و تجعله مرتبا و مرنا و سهلا

أما على مستوى المستخدم فنعم يمكن اضافة InputBox  او فورم كما تفضلت

 

 

 

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

أخى وأستاذى الغالى جعفر     زادك الله بسطةً  فى العلم و الرزق  أشكرك على هذا التوضيح  

أخى وأستاذى الغالى  ياسر    زادك الله بسطةً  فى العلم و الرزق  أشكرك على هذا الدعاء

 

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information