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

[مختار حسين محمود]

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

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

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

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

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

[عادل حنفي]

اخي العزيز مختار حسين محمود

تسلم يداك عمل اكثر من رائع

تحياتي

[عبد العزيز البسكري]

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

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

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

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

 

[ياسر خليل أبو البراء]

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

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

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

[مختار حسين محمود]

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

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

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

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

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

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

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

[Yasser Fathi Albanna]

سلمت يمينك أخى الحبيب مختار

عمل أكثر من رائع

وإلى الأمام دائما

وفقك الله

[مختار حسين محمود]

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

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

[محمد الورفلي1]

السلام عليكم

استاذ مختار

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

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

[مختار حسين محمود]

السلام عليكم

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

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

تم تعديل أكتوبر 5, 2015 بواسطه مختار حسين محمود

[جعفر الطريبق]

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

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

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

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

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

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

[محمد حسن المحمد]

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

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

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

[مختار حسين محمود]

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

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

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

[جعفر الطريبق]

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

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

اليك هدا التعديل للكود فهو يتحسب مسبقا لأي أخطاء ممكن أن تحدث كما أنه أسرع و أكثر مرونة بسبب ال 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

 

تم تعديل أكتوبر 5, 2015 بواسطه جعفر الطريبق

[مختار حسين محمود]

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

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

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

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

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

[جعفر الطريبق]

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

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

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

 

 

 

[ياسر خليل أبو البراء]

أخي الحبيب مختار

أخي الحبيب جعفر

بارك الله فيكما وجزاكما الله خير الجزاء في الدنيا والآخرة

[مختار حسين محمود]

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

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