עזרה | קוד להסרת ' או " לפי התאמה אישית

אוריי

@pcinfogmach
לבנתיים אני התחלתי עם פונקציה של גימטריה שמחזירה לי את הר"ת לפי בחירה אם או בלי.
זה הקוד:

Function GIMATRIA(x, Acronyms As Boolean)
 
    g = ""
    TV = Int(x / 400)
    For i = 1 To TV
        g = g & "ת"
    Next i
    x = x - (TV * 400)
    TV = Int(x / 300)
    For i = 1 To TV
        g = g & "ש"
    Next i
    x = x - (TV * 300)
    TV = Int(x / 200)
    For i = 1 To TV
        g = g & "ר"
    Next i
    x = x - (TV * 200)
    TV = Int(x / 100)
    For i = 1 To TV
        g = g & "ק"
    Next i
    x = x - (TV * 100)
    TV = Int(x / 90)
    For i = 1 To TV
        g = g & "צ"
    Next i
    x = x - (TV * 90)
    TV = Int(x / 80)
    For i = 1 To TV
        g = g & "פ"
    Next i
    x = x - (TV * 80)
    TV = Int(x / 70)
    For i = 1 To TV
        g = g & "ע"
    Next i
    x = x - (TV * 70)
    TV = Int(x / 60)
    For i = 1 To TV
        g = g & "ס"
    Next i
    x = x - (TV * 60)
    TV = Int(x / 50)
    For i = 1 To TV
        g = g & "נ"
    Next i
    x = x - (TV * 50)
    TV = Int(x / 40)
    For i = 1 To TV
        g = g & "מ"
    Next i
    x = x - (TV * 40)
    TV = Int(x / 30)
    For i = 1 To TV
        g = g & "ל"
    Next i
    x = x - (TV * 30)
    TV = Int(x / 20)
    For i = 1 To TV
        g = g & "כ"
    Next i
    If x = 15 Then
        g = g & "טו"
    Else
        If x = 16 Then
            g = g & "טז"
        Else
            
            x = x - (TV * 20)
            TV = Int(x / 10)
            For i = 1 To TV
                g = g & "י"
            Next i
            x = x - (TV * 10)
            TV = Int(x / 9)
            For i = 1 To TV
                g = g & "ט"
            Next i
            x = x - (TV * 9)
            TV = Int(x / 8)
            For i = 1 To TV
                g = g & "ח"
            Next i
            x = x - (TV * 8)
            TV = Int(x / 7)
            For i = 1 To TV
                g = g & "ז"
            Next i
            x = x - (TV * 7)
            TV = Int(x / 6)
            For i = 1 To TV
                g = g & "ו"
            Next i
            x = x - (TV * 6)
            TV = Int(x / 5)
            For i = 1 To TV
                g = g & "ה"
            Next i
            x = x - (TV * 5)
            TV = Int(x / 4)
            For i = 1 To TV
                g = g & "ד"
            Next i
            x = x - (TV * 4)
            TV = Int(x / 3)
            For i = 1 To TV
                g = g & "ג"
            Next i
            x = x - (TV * 3)
            TV = Int(x / 2)
            For i = 1 To TV
                g = g & "ב"
            Next i
            x = x - (TV * 2)
            TV = Int(x / 1)
            For i = 1 To TV
                g = g & "א"
            Next i
            x = x - (TV * 1)
        End If
    End If
    
    If Acronyms = True Then
        If Len(g) > 1 Then g = Left(g, Len(g) - 1) & """" & Right(g, 1)
        If Len(g) = 1 Then g = g & "'"
    End If
    
    GIMATRIA = g
    
End Function

pcinfogmach

@אוריי
הסבר נא למה הגימטריא מועיל למקרה זה
ובמה בדיוק תרצה שנעזור לך

דנבו

@אוריי
עזוב אותך מכל האוטמציות האלה, חלק את הטקסט לכמה חברים כל יום תעבור על חלק וזה ייגמר בסוף.

אוריי

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

אוריי

@דנבו
אתה רוצה לעזור לי....
לבנתיים אין לי אף אחד

pcinfogmach

@אוריי

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

אגב איך הגימטריאות יכללו מפעים כמו סק"א ?

אוריי

@pcinfogmach
אם אני יחפש באופן הנ"ל אני יקבל גם ר"ת כמו כי"א שלעולם זה לא יכול להיות סימן

pcinfogmach

@אוריי
אהה
ואיך הגימטריא יפתור את זה?

אוריי

@pcinfogmach
מה לא ברור בזה?

pcinfogmach

@אוריי
למה באופן של גימטריא שלא תקבל את הר"ת של כי"א הרי הוא יזהה את י"א כגימטריא לא?

אוריי

@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

pcinfogmach

@pcinfogmach

כמה הערות לגבי המאקרו:

המאקרו הנ"ל נכתב עבור צורך מסויים מצו"ב מאקרו שתוכלו לחפש איתו מה שרק תרצו מאקרו חיפוש והחלפה פרטניים
לא ראיתי צורך שיופיע בתוך תיבת ההחלפה הטקסט לפני ואחרי מאחר שהמאקרו עובד עם חיפוש והחלפה ומסמן בתוך המסמך עצמו היכן המופע הנוכחי. תנסה ותראה. (אם חלונית ההחלפה מסתירה תוכל לגרור אותה לצד).

pcinfogmach

@אוריי
מאקרו מעודכן עם קיצורי מקשים והכל - ממש אוטומציה כמו שרצית - בהצלחה!
הוראות בפנים.
המאקרו נמצא כאן

(אגב אפשר לשנות את קיצורי המקשים כאן:)

ספויילר

והנה הקוד אם אתה רוצה לשחק אתו:

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
להוסיף קיצור דרך לתוצאה קודמת.

pcinfogmach

@אוריי

המאקרו עודכן

כדי לבטל פעולה אחרונה אפשר להשתמש עם ctrl+z
נוסף קיצור דרך לתוצאה קודמת.

הוראות חדשות בתוך המאקרו
https://mitmachim.top/assets/uploads/files/1680032226437-חיפוש-והחלפה-פרטניים.zip