עזרה הדדית - VBA excel

Spoiler הסיבה ללולאה האינסופית באופיס 365 היא האופן שבו הלולאה For Each word In doc.Words עובדת בשילוב עם עריכת הטקסט: כאשר משנים את word.Text, אוסף ה-Words במסמך מתעדכן בזמן אמת, מוחק את הרווח העוקב שהיה צמוד למספר, ומגדיר מחדש את הטווח כך שהמאקרו מזהה את המספר החדש שוב ושוב (או מאחד אותו עם המילה הבאה). בנוסף, במאקרו המקורי שלך הפונקציה השנייה (min_num) הכילה בטעות + 1 במקום - 1. כדי לפתור את הבעיה לגמרי, יש לעבור על המילים מהסוף להתחלה (לולאת For i = ... Step -1) או להשתמש בחיפוש מבוסס תווים כלליים (Wildcards), ולשמור על הרווח שאחרי המספר במידה והיה קיים. להלן הקוד המתוקן והמלא (כולל החלק שמוסיף רווח קשיח ^s לאחר המספרים כפי שהיה אצלך בקוד המקורי, ותיקון של פונקציית ההפחתה min_num):

@יעקב-ש Sub ImportCommentsToTable() Dim wsSource As Worksheet Dim wsDest As Worksheet Dim cmt As Comment Dim rng As Range Dim lastRow As Long Dim destRow As Long Set wsSource = ActiveSheet ' צור גיליון חדש לתוצאות Set wsDest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) wsDest.Name = "הערות מיובאות" ' כותרות לטבלה wsDest.Range("A1").Value = "מיקום תא" wsDest.Range("B1").Value = "תוכן תא" wsDest.Range("C1").Value = "תוכן הערה" destRow = 2 ' שורה להתחלת הדאטה ' עבור כל התא עם הערה בגיליון המקורי For Each cmt In wsSource.Comments wsDest.Cells(destRow, 1).Value = cmt.Parent.Address(False, False) ' מיקום התא wsDest.Cells(destRow, 2).Value = cmt.Parent.Value ' תוכן התא wsDest.Cells(destRow, 3).Value = cmt.Text ' תוכן ההערה destRow = destRow + 1 Next cmt ' עצב טבלה lastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row wsDest.Range("A1:C" & lastRow).Select wsDest.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "CommentsTable" wsDest.ListObjects("CommentsTable").TableStyle = "TableStyleMedium9" MsgBox "ייבוא ההערות הסתיים. נמצאו " & destRow - 2 & " הערות.", vbInformation End Sub מרובי בוט

@יעקב-ש בשאילתא אתה יכול לפצל את העמודה לפי כמות המילים ואח"כ תמשיך סיבוב עמודות בהצלחה

אין לי אפשרות ללייק... תזכה לפול ישועות!

הנה קוד מקוצר, במקום לבדוק תא תא אנחנו מחפשים/סופרים 3 תאים המכילים ערכים בטווח. עוד משהו חמוד שעכשיו זה חוזר להיות מוסתר עם מוחקים משהו מהתאים. Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:C1")) Is Nothing Then Sheets("Sheet2").Visible = Application.WorksheetFunction.CountA(Range("A1:C1")) = 3 If Sheets("Sheet2").Visible Then MsgBox "Sheet2 Is Now Visible." End If End Sub

@menajemmendel הסתדרתי תודה רבה בכל אופן @דאבל יש כח גדול על זה שהעיר את תשומת ליבי מה הבעיה

@משחזר-מידע ייישששששששששר כוייייייחחחחחחח זה עובד ומה עכשיו איך לשמור את זה שלא כל פעםפ אני יצרטך להפעיל במצב בטוח

@היימישע שמחתי לעזור. רק שים לב שהכותרת של הנושא לא קשורה לתוכן. השתדל להקפיד על הכללים, כך יהיה אפשר לעזור יותר נכון לאחרים.

@ישראליק התיקון אצלי לא עובד עדיין קופץ לי שגיאה! [image: 1696955880254-e0e2763b-7dee-46d6-9a72-45d4cd090074-image.png] לא עזר אישור פקודות מאקרו במרכז מהימן. זה די דחוף לי אשמח למי שיש תוכנת אקסל תקינה יעזור לי מאוד תודה רבה. עריכה: הפתרון הוא קליק ימני על הקובץ מאפיינים ולהסיר את החסימה [image: 1696956131951-38b30eed-12c3-473a-af75-46f7a62ccee0-image.png]

@מגדלים גיליונות שאני הוספתי לקובץ גימטריה מתרגם מספר לאותיות ולועזי מכיל את התאריך הלועזי של א' בחודש העברי משנת תר"ס עד שנת תת"ר

@3157686 לא קשור ל-VBA. תכין קובץ בוורד של האישור לימודים, ותשאיר מקום ריק ליד השם, לאחר מכן תכין קובץ אקסל עם כל השמות, תשמור ותסגור. לאחר מכן, תכנס ל-"דברי דואר" ותעשה מיזוג. [image: 1687426633805-9b658850-9758-4739-a2c8-ef4d7f8d85ef-image.png] אם אתה רוצה פירוט יותר כנס לכאן: https://mitmachim.top/post/654117 יש שם מישהו ששואל על מדבקות, אבל הפעולה היא ממש אותה פעולה. אגב, את היכול לשים כמה שדות, לא רק שמות, למשל תאריך לידה, כתובת, מספר זהות וכו. רק שים לב שבאקסל שה יהיה בעמודה נפרדת באופן מקביל באותה שורה של השם.

@טכנופוב אם תלחץ על מידע נוסף תראה איך להסיר את החסימה אגב שדרגתי את הקוד קצת בפוסט למעלה עם כפתור התחל והפסק שמחתי לעזור ושמחתי שהסתדרת

@מטעמים ואיפה צריך לשאול את זה?

@סקרן-0 תודה לכל המשיבים!! נעמתם לי מאוד

@121244 זה אומר שסגור לקהילה שאתה משוייך (כלומר בנטפרי הרגיל פתוח,אבל יש אפשרות לבחור שלא כל האתרים בנטפרי יהיו פתוחים לך אלא רק חלק מהם, וכ''כ יש קהילות שהגדירו שחלק מהאתרים יהיו סוגרים, וכשאתה הצטרפת לנפטרי בחרת להיות משוייך לאיזהו קהילה [נטפרי לא מחייב]) (אגב אין המטרה שלי לייאש אותך מVBA ,אבל אני אומר כדי להועיל, מהשאלה שלך ניכר שהאנגילת שלך הוא ברמה מאד נמוכה [כלומר הרבה פחות מהבסיסי שצריך לשפת תכנות], לא כמו שהיה נראה מהודעות לעיל שהוא ברמה בסיסית, קח בחשבון שאחרי שתלמד איך עובד VBA אז תצטרך לקודד באנגלית כי כל הפקודות הם באנגלית, ועוד שלא שייך להסתדר לקודד לבד, במיוחד למתחילים על כל צד ושעל אתה צריך לחפש חומר (לחפש איך קוראים לפדוקה מסויימת וכו') וכל האתרים לזה הם באנגלית (מלבד אתר 1, האתר של MICROSOFT שהוא רק חצי באנגלית, אז לך ולכל מי שמעונין ללמדו איזה שפת תכנות נ''ל שמוכרח אנגלית ברמה בסיסית לפחות, (לא חייבים קריאה שוטפת, אבל כן קריאה בשעת הדחק) מלבד זאת יכול להיות שהרבה אתרים של תכנות אולי סגורים בקהילתך כמו שסגור הGPT (שהוא "ה"אתר היום הכי יעיל לתכנות) אז כדאי לך קודם ללמוד אנגלית, יש הרבה תוכנות חנמיות לזה וסליחה על אריכות (

@שלום-עולם מצוין!! תודה.

@מאקרו לא יודע למה לפעמים לעבוד בצורה ישירה עובד ולפעמים לא במקרה זה אם זה עובד אז מצויין

@menajemmendel אז תעשה ככה Do While Selection.Find.Execute If Selection.Range.End < ActiveDocument.Range.End Then Selection.MoveLeft Unit:=wdCharacter, Count:=1 'Selects a first word and applies a style to it Selection.MoveEndUntil Cset:=" ", Count:=wdForward Selection.Style = ActiveDocument.Styles(nombre_del_Nuevo_Estilo) Selection.MoveDown Unit:=wdParagraph, Count:=1 Else Exit Do End If Loop אם קיימת אפשרות שהסגנון שאתה מחפש עשוי להופיע מספר פעמים בסוף המסמך, תוכל לשנות את הקוד כדי לבדוק אם סוף טווח הבחירה נמצא במרחק מסוים מסוף המסמך. לדוגמה, ניתן לבדוק אם סוף טווח הבחירה נמצא בטווח של 10 תווים מסוף המסמך. הנה דוגמה: Do While Selection.Find.Execute If ActiveDocument.Range.End - Selection.Range.End > 10 Then Selection.MoveLeft Unit:=wdCharacter, Count:=1 'Selects a first word and applies a style to it Selection.MoveEndUntil Cset:=" ", Count:=wdForward Selection.Style = ActiveDocument.Styles(nombre_del_Nuevo_Estilo) Selection.MoveDown Unit:=wdParagraph, Count:=1 Else Exit Do End If Loop בדוגמה זו, ההצהרה If בודקת אם ההבדל בין סוף המסמך לסוף טווח הבחירה גדול מ-10 תווים. אם כן, הלולאה ממשיכה. אם לא, הלולאה יוצאת. בדרך זו, הלולאה תצא אם היא תגיע לסוף המסמך או אם היא נתקעת בסוף המסמך עקב מופעים מרובים של הסגנון.