ג' שואל:
שלום ברשותי דוח אשר מופק אחת לשבוע, לאחר שאני מכניס שם HYPERLINK ברצוני שגם בשבוע שלאחר מכן הוא יידע לעבור על הגיליון הקודם ולבצע השוואה,במידה וקיים HYPERLINK אז להציג אותו גם בגיליון החדש. כיצד כותבים פקודת מאקרו לפעולה זו?
תודה מראש
תשובה:
מצ"ב דוגמה לסנכרון רשימת קישורים בין גיליון מקור לגיליון יעד על ידי שימוש בקוד VBA.
הקוד עובר על עמודה A בגיליון Source.
במידה ומופיע בתא קישור אז הוא מועתק לגיליון Target.
במידה ולא מופיע בתא קישור אז נמחק הערך בתא המקביל בגיליון Target.
שלב 1 - נגדיר באקסל גיליון Source שיכיל רשימת קישורים וגיליון Target עם רשימת קישורים ריקה.


שלב 2 -נגדיר ב-VBA מודול חדש המכיל את השגרה הבאה -
Public Sub CopyLinks()
Dim lngRow As Long, strLink As String
'מעבר על שורות 2 עד 100 בגיליון מקור
For lngRow = 2 To 100
'העתקת קישור מגיליון מקור לגיליון מטרה
If Worksheets("Source").Range("A" & lngRow).Value > "" Then
If Worksheets("Source").Range("A" & lngRow).Hyperlinks.Count = 1 Then
strLink = Worksheets("Source").Range("A" & lngRow).Hyperlinks(1).Address
Worksheets("Target").Range("A" & lngRow).Hyperlinks.Add Anchor:=Worksheets("Target").Range("A" & lngRow), Address:=Worksheets("Target").Range("A" & lngRow)
Worksheets("Target").Range("A" & lngRow).Hyperlinks(1).Address = strLink
Worksheets("Target").Range("A" & lngRow) = Worksheets("Source").Range("A" & lngRow)
End If
End If
'מחיקת קישור בגיליון מטרה במידה ולא קיים בגיליון מקור
If Worksheets("Source").Range("A" & lngRow).Value = "" Then
Worksheets("Target").Range("A" & lngRow).Hyperlinks.Delete
Dim lngRow As Long, strLink As String
'מעבר על שורות 2 עד 100 בגיליון מקור
For lngRow = 2 To 100
'העתקת קישור מגיליון מקור לגיליון מטרה
If Worksheets("Source").Range("A" & lngRow).Value > "" Then
If Worksheets("Source").Range("A" & lngRow).Hyperlinks.Count = 1 Then
strLink = Worksheets("Source").Range("A" & lngRow).Hyperlinks(1).Address
Worksheets("Target").Range("A" & lngRow).Hyperlinks.Add Anchor:=Worksheets("Target").Range("A" & lngRow), Address:=Worksheets("Target").Range("A" & lngRow)
Worksheets("Target").Range("A" & lngRow).Hyperlinks(1).Address = strLink
Worksheets("Target").Range("A" & lngRow) = Worksheets("Source").Range("A" & lngRow)
End If
End If
'מחיקת קישור בגיליון מטרה במידה ולא קיים בגיליון מקור
If Worksheets("Source").Range("A" & lngRow).Value = "" Then
Worksheets("Target").Range("A" & lngRow).Hyperlinks.Delete
Worksheets("Target").Range("A" & lngRow) = ""
End If
End If
Next lngRow
End Sub

שלב 3 - נפעיל את השגרה ונקבל את התוצאה הבאה בגיליון Target -

בברכה,
צוות אניפיט