מ' שואלת:
שלום לכולם,
אני צריכה נוסחה שמאתרת בחוברת עבודה כולה מילה מסוימת ומסכמת את המספר שלידה כאשר המילים מפוזרות בקובץ ללא מיקום קבוע.תשובה:
מצ"ב הצעה לפיתרון -
ניתן לבצע זאת באקסל על ידי הגדרת פרוצדורה ב-VBA שתחפש בכל הגיליונות בחוברת העבודה מילה מסויימת ותסכום את המספרים הנמצאים בסמוך למילה.
מצ"ב הצעה לפתרון על ידי שימוש בקוד VBA -
1. בגיליון אקסל נגדיר במספר תאים את הערך "קורונה" ובתאים הסמוכים ערכים מספריים. לדוגמא:
2. נפתח את עורך VBA של אקסל על ידי לחיצה על Alt+F11, נסמן את Microsoft Excel Objects ונבחר ב-Insert Module.
3. נסמן את Module1 ונבחר ב-View Code.
4. נעתיק ונדביק את הקוד הבא לאקסל -
הקוד כולל את הפוקציה Find_All שמקבלת כפרמטרים טווח לחיפוש נתונים ומילה לחיפוש ומחזירה את כתובות התאים בהם נמצאה המילה.
ואת הפרוצדורה Total_Corona שסוכמת את הערכים המופיעים ליד המילה "קורונה" בכל הגיליונות בחוברת העבודה.
הפרוצדורה עוברת על כל הגיליונות בחוברת העבודה.
עבור כל גיליון מבוצעת קריאה לפונקציה Find_All המחזירה את כתובות התאים בגיליון בהם נמצאה המילה "קורונה".
במידה המילה "קורונה" נמצאה בגיליון - מבוצע מעבר על התאים בהם נהיא נמצאה ומבוצעת סכימה של הערכים בתאים הסמוכים.
בסיום המעבר על כל הגיליונות בחוברת העבודה, הפרוצדורה מציגה כפלט את סך הערכים שנסכמו.
Public Sub Total_Corona()
Dim wSh As Worksheet, rngFoundCells As Range, cell As Range, dblTotal As Double
For Each wSh In ThisWorkbook.Worksheets
Set rngFoundCells = Find_All(wSh.UsedRange, "קורונה")
If Not rngFoundCells Is Nothing Then
For Each rngCell In rngFoundCells
dblTotal = dblTotal + rngCell.Offset(0, 1).Value
Next rngCell
End If
Next wSh
MsgBox "סך קורונה " & dblTotal, vbInformation
End Sub
Public Function Find_All(ByVal rng As Range, ByVal searchTxt As String) As Range
Dim foundCell As Range, firstAddress As String, rResult As Range
With rng
Set foundCell = .Find(What:=searchTxt, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not foundCell Is Nothing Then
firstAddress = foundCell.Address
Do
If rResult Is Nothing Then
Set rResult = foundCell
Else
Set rResult = Union(rResult, foundCell)
End If
Set foundCell = .FindNext(foundCell)
Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
End If
End With
Set Find_All = rResult
End Function
6 נחזור לגיליון האקסל ונלחץ על Alt + F8 ונבחר במקרו Total_Corona ונלחץ על Run.


בברכה,
צוות AnyFit