עקבו אחרינו בפייסבוק:

צביעת כל התאים המרכיבים סכום מסוים על ידי מאקרו

Print Friendly, PDF & Email

קרה לכם פעם שנתקלתם בסכום שהיה מורכב ממספר רב של תאים, ולא מצאתם דרך פשוטה לסמן בבת אחת את כל התאים שמרכיבים את הסכום הזה? 
המאקרו שיוצג בהמשך יאפשר לכם לעשות זאת בקלות.

 

כך נראה המאקרו בפעולה:

כמה דגשים לגבי המאקרו

  1. הוא פועל אך ורק על תאים המכילים פעולות בסיסיות – חיבור/חיסור/כפל/חילוק
  2. הוא מסוגל להתמודד עם נוסחה המכילה תאים בגיליונות שונים – אך כל התאים חייבים להיות באותו הקובץ.
  3. לא ניתן לבטל את הצביעה אחרי הרצת המאקרו, לכן – כמו בכל מאקרו – הקפידו לשמור את הקובץ לפני שאתם מריצים את המאקרו.
  4. אנו ממליצים בחום להוסיף בסרגל הכלים כפתור שיאפשר להפעיל את המאקרו בלחיצה.

כך נראה הקוד (למדריך להרצת מאקרו לחצו כאן):

Sub color_cells_in_formula()

Dim workrng As Range

Dim lcolor As Long

   Set workrng = Application.Selection

   Set workrng = Application.InputBox("Range", xTitleId, workrng.Address, Type:=8)

If Application.Dialogs(xlDialogEditColor).Show(10, 0, 125, 125) = True Then

  lcolor = ActiveWorkbook.Colors(10)

Else

End If

For Each cell In workrng

If cell.Value <> "" Then

   Dim result As String

   result = cell.Formula

   result = Replace(result, "(", "   ")

   result = Replace(result, ")", "   ")

   result = Replace(result, "-", "   ")

   result = Replace(result, "+", "   ")

   result = Replace(result, "*", "   ")

   result = Replace(result, "/", "   ")

   result = Replace(result, "=", "   ")

   result = Replace(result, ",", "   ")

   Dim cells() As String

   cells = Split(Trim(result), "   ")

   For j = 0 To UBound(cells)

    Range(cells(j)).Interior.Color = lcolor

   Next j

End If

Next cell

End Sub

נשמח לשמוע מכם פידבקים!

 

אהבתם? שתפו עם החברים:

השאר תגובה