צביעת כל התאים המרכיבים סכום מסוים על ידי מאקרו
קרה לכם פעם שנתקלתם בסכום שהיה מורכב ממספר רב של תאים, ולא מצאתם דרך פשוטה לסמן בבת אחת את כל התאים שמרכיבים את הסכום הזה?
המאקרו שיוצג בהמשך יאפשר לכם לעשות זאת בקלות.
כך נראה המאקרו בפעולה:
כמה דגשים לגבי המאקרו
- הוא פועל אך ורק על תאים המכילים פעולות בסיסיות – חיבור/חיסור/כפל/חילוק
- הוא מסוגל להתמודד עם נוסחה המכילה תאים בגיליונות שונים – אך כל התאים חייבים להיות באותו הקובץ.
- לא ניתן לבטל את הצביעה אחרי הרצת המאקרו, לכן – כמו בכל מאקרו – הקפידו לשמור את הקובץ לפני שאתם מריצים את המאקרו.
- אנו ממליצים בחום להוסיף בסרגל הכלים כפתור שיאפשר להפעיל את המאקרו בלחיצה.
כך נראה הקוד (למדריך להרצת מאקרו לחצו כאן):
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
נשמח לשמוע מכם פידבקים!