עזרה | קוד להסרת ' או " לפי התאמה אישית
-
@pcinfogmach
ע"י זה אני יכול להחזיר את הסימנים בלבד
אני מריץ בלופ את כל המספרים ומקבל את הגימטרייה שלו כולל ה"
ואני שולח את זה לפונקצית החלפה ועובר על כל המופעים של א' ומחליף אותם לפי בחירה
ואח"כ את בל המופעים של ב' וכו'... -
אם הבנתי נכון אתה רוצה לחסוך את הצורך להזין את כל המופעים של א' ב' ג' י"א י"ב י"ג וכו'
לא בטוח שזה באמת חוסך משהו כי לכאורה על ידי שלוש או ארבע פקודות כללת את כל המופעים
לדוגמא:א-י
עם'
וגםי-צ
עם"
ועםא-ט
אגב איך הגימטריאות יכללו מפעים כמו סק"א ?
-
@pcinfogmach
אם אני יחפש באופן הנ"ל אני יקבל גם ר"ת כמוכי"א
שלעולם זה לא יכול להיות סימן -
@pcinfogmach
מה לא ברור בזה? -
@pcinfogmach אני לא רוצה לקבל את הר"ת הזו כלל (אמנם אני יכול לקבל את זה בגימטריה של י"א אבל אני יכול לעשות חיפוש עם רווח לפני כך שהוא לא יופיע).
-
@pcinfogmach גם אותו אני לא רוצה שיופיע
-
@אוריי
מצטער שלא ירדתי לעומק דעתך בכל אופן אולי משהו כזה יעזור לך?כרגע המאקרו מחפש רק מ- י"א עד צ"ט. מה שישמש אותך עבור רוב המופעים כולל תקי"א מאחר שהוא ימצא את האותיות י"א שבתוך סימן זה.
לחיפוש מופעים אחרים תצטרך להתאים אותו מחדש אולי זה מה שניסית לעשות עם הגימטריאות?Sub מאקרו_חיפוש_והחלפה_פרטני() ' על ידי pcinfogmach ' 'מאקרו זה נועד להקל על חיפוש והחלפה של מופעים רבים באופן פרטני 'מאקרו זה יכול לשמש עבור כל חיפוש והחלפה שתרצו כדלהלן: ' 'פשוט יש להחליף את הקודים של החיפוש תחת '.Text = 'ואת הקודים של ההחלפה תחת '.Replacement.Text = 'הכללים של הקודים הם לפי תווים כלליים. אם ברצונכם להשתמש עם כללי חיפוש והחלפה רגילים יש לשנות את: '.MatchWildcards = True 'ל- .MatchWildcards = False nxt: Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "([י-צ])(\"")([א-ט])" .Replacement.Text = "\1\3" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Dim userResponse As VbMsgBoxResult Dim replaceCount As Integer replaceCount = 0 ' Find the first match Selection.Find.Execute ' Prompt the user to replace or not userResponse = MsgBox("הטקסט שנמצא הוא: " & Selection.Text & vbNewLine & vbNewLine & "להחליף או לא? ", vbYesNoCancel + vbMsgBoxRight + vbMsgBoxRtlReading, "חיפוש והחלפה") While Selection.Find.found If userResponse = vbYes Then ' Replace current match and count Selection.Find.Execute Replace:=wdReplaceOne replaceCount = replaceCount + 1 GoTo nxt: End If If userResponse = vbNo Then GoTo nxt: End If If userResponse = vbCancel Then GoTo endr Wend endr: ' Show the number of replacements made MsgBox "הוחלפו " & replaceCount & " מופעים." End Sub ```kotlin
-
כמה הערות לגבי המאקרו:
-
המאקרו הנ"ל נכתב עבור צורך מסויים מצו"ב מאקרו שתוכלו לחפש איתו מה שרק תרצו מאקרו חיפוש והחלפה פרטניים
-
לא ראיתי צורך שיופיע בתוך תיבת ההחלפה הטקסט לפני ואחרי מאחר שהמאקרו עובד עם חיפוש והחלפה ומסמן בתוך המסמך עצמו היכן המופע הנוכחי. תנסה ותראה. (אם חלונית ההחלפה מסתירה תוכל לגרור אותה לצד).
-
-
@אוריי
מאקרו מעודכן עם קיצורי מקשים והכל - ממש אוטומציה כמו שרצית - בהצלחה!
הוראות בפנים.
המאקרו נמצא כאן(אגב אפשר לשנות את קיצורי המקשים כאן:)
ספויילרוהנה הקוד אם אתה רוצה לשחק אתו:
Sub Macro1() ' ' Macro1 Macro ' ' Selection.MoveRight Unit:=wdCharacter, Count:=1 End Sub Sub Macro2() ' ' Macro2 Macro ' ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "כדי" .Replacement.Text = "@@@@" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "כדי" .Replacement.Text = "@@@@" .Forward = False .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute End Sub
-
@pcinfogmach
כמה פרטים שיכולים להקל- להוסיף קיצור לביטול פעולה אחרונה כמו ctrl+z
- להוסיף קיצור דרך לתוצאה קודמת.
-
- כדי לבטל פעולה אחרונה אפשר להשתמש עם ctrl+z
- נוסף קיצור דרך לתוצאה קודמת.
הוראות חדשות בתוך המאקרו
https://mitmachim.top/assets/uploads/files/1680032226437-חיפוש-והחלפה-פרטניים.zip -
@pcinfogmach
אתה יכול לשלוח לי את הקוד המעודכן? -
@אוריי כתב בעזרה | קוד להסרת ' או " לפי התאמה אישית:
@pcinfogmach
אתה יכול לשלוח לי את הקוד המעודכן?בבקשה:
(לא לשכוח להגדיר את הקיצורי דרך עיין ספויילר)Public searchWord As String Public replaceWord As String Public useWildcards As Boolean Sub מאקרו_חיפוש_והחלפה_פרטניים_התחלת_חיפוש() ' ' By pcinfogmach searchWord = InputBox(":הזן מילה או קוד לחיפוש") replaceWord = InputBox(":הזן מילה או קוד להחלפה") useWildcards = MsgBox("האם ברצונך להשתמש בתווים כלליים?", vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading) = vbYes Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = searchWord .Replacement.Text = replaceWord .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute End Sub Sub מאקרו_חיפוש_והחלפה_פרטניים_חפש_הבא() With Selection.Find .Forward = True .Wrap = wdFindAsk End With Selection.Find.Execute End Sub Sub מאקרו_חיפוש_והחלפה_פרטניים_חפש_הקודם() With Selection.Find .Forward = False .Wrap = wdFindAsk End With Selection.Find.Execute End Sub Sub מאקרו_חיפוש_והחלפה_פרטניים_החלפה() With Selection.Find .Forward = True .Wrap = wdFindAsk End With Selection.Find.Execute Replace:=wdReplaceOne Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Find.Execute End Sub Sub מאקרו_חיפוש_והחלפה_פרטניים_למי_שלא_מתאים_לו_קיצורי_מקשים_עם_תפריט_בחירה() ' ' על ידי pcinfogmach 'מאקרו זה יכול לשמש עבור כל חיפוש והחלפה שתרצו Dim findText As String Dim replaceText As String Dim useWildcards As Boolean Dim userResponser As Integer userResponser = MsgBox("האם אתם רוצים להשתמש בתווים כלליים בחיפוש זה?", vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "חיפוש והחלפה פרטניים") useWildcards = (userResponser = vbYes) findText = InputBox(":הזן טקסט או קוד לחיפוש") replaceText = InputBox(":הזן טקסט או קוד להחלפה") nxt: Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = findText .Replacement.Text = replaceText .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = useWildcards End With Dim userResponse As VbMsgBoxResult Selection.Find.Execute ' Prompt the user to replace or not userResponse = MsgBox("הטקסט שנמצא הוא: " & Selection.Text & vbNewLine & vbNewLine & "להחליף או לא? ", vbYesNoCancel + vbMsgBoxRight + vbMsgBoxRtlReading, "חיפוש והחלפה פרטניים") While Selection.Find.Found If userResponse = vbYes Then ' Replace current match and count Selection.Find.Execute Replace:=wdReplaceOne Selection.MoveRight Unit:=wdCharacter, Count:=1 GoTo nxt: End If If userResponse = vbNo Then GoTo nxt: End If If userResponse = vbCancel Then Exit Sub Wend End Sub