בקשת מידע | המרת אותיות למספרים באקסל

[pcinfogmach]

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

[ח.ש.]

@pcinfogmach ישר כח.
בלנ"ד מחר אביא את הקובץ ואשלח לך.

[pcinfogmach]

קוד מאקרו (לאקסל) להמיר מספור אותיות למספרים ולהוסיף/להפחית מספר קבוע ואח"כ להמיר שוב לאותיות.
עריכה:
המאקרו עובר בלולאה על כל התאים המסומנים לפי בחירה

בלי לשון נקיה

 Sub הגדל_מספור_אותיות()

    Dim MyArray() As Variant
    Dim MyaArray() As Variant
    Dim inputString As String
    Dim outputNumber As Long
    Dim plusNumber As Integer
    
    Dim i As Integer
    Dim j As Integer
    
    plusNumber = InputBox("הזן במפרים בכמה רצונך להגדיל את המספור")
    
    Dim cell As Range
    For Each cell In Selection

    ' replacement arrays
    MyArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", "י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
    MyaArray = Array("400", "300", "200", "100", "90", "80", "70", "60", "50", "40", "30", "20", "10", "9", "8", "7", "6", "5", "4", "3", "2", "1")
    
    
        inputString = cell.Value
'        If IsNumeric(inputString) Then GoTo nxt
        
        ' Loop through each character in the input string
        For i = 1 To Len(inputString)
            ' Loop through the MyArray to find a match for the character
            For j = LBound(MyArray) To UBound(MyArray)
                If Mid(inputString, i, 1) = MyArray(j) Then
                    outputNumber = outputNumber + MyaArray(j)
                    Exit For
                End If
            Next j
        Next i
        
        outputNumber = outputNumber + plusNumber
        
        ' Replace the word with the output number
       
       cell.Value = ConvertToHebrew(outputNumber)
       
       outputNumber = 0
       
       Next cell
       
End Sub

Function ConvertToHebrew(ByVal ftnoteNumber As Long) As String
    Dim MyArray As Variant
    Dim MyaArray As Variant
    Dim v As Long
    Dim s As String
    Dim i As Long

s = ""

MyArray = Array(400, 300, 200, 100, 90, 80, 70, 60, 50, 40, 30, 20, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
MyaArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", _
"י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
v = Val(ftnoteNumber)
Do While v > 0
If v = 15 Or v = 16 Then
s = s & "ט"
v = v - 9
End If
  For i = 0 To UBound(MyArray)
    If v >= MyArray(i) Then
      s = s & MyaArray(i)
      v = v - MyArray(i)
      Exit For
    End If
  Next i
Loop

ConvertToHebrew = s

End Function

עם לשון נקיה

 Sub הגדל_מספור_אותיות()

    Dim MyArray() As Variant
    Dim MyaArray() As Variant
    Dim inputString As String
    Dim outputNumber As Long
    Dim plusNumber As Integer
    
    Dim i As Integer
    Dim j As Integer
    
    plusNumber = InputBox("הזן במפרים בכמה רצונך להגדיל את המספור")
    
    Dim cell As Range
    For Each cell In Selection

    ' replacement arrays
    MyArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", "י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
    MyaArray = Array("400", "300", "200", "100", "90", "80", "70", "60", "50", "40", "30", "20", "10", "9", "8", "7", "6", "5", "4", "3", "2", "1")
    
    
        inputString = cell.Value
'        If IsNumeric(inputString) Then GoTo nxt
        
        ' Loop through each character in the input string
        For i = 1 To Len(inputString)
            ' Loop through the MyArray to find a match for the character
            For j = LBound(MyArray) To UBound(MyArray)
                If Mid(inputString, i, 1) = MyArray(j) Then
                    outputNumber = outputNumber + MyaArray(j)
                    Exit For
                End If
            Next j
        Next i
        
        outputNumber = outputNumber + plusNumber
        
        ' Replace the word with the output number
       
       cell.Value = ConvertToHebrew(outputNumber)
       
       outputNumber = 0
       
       Next cell
       
End Sub

Function ConvertToHebrew(ByVal ftnoteNumber As Long) As String
    Dim MyArray As Variant
    Dim MyaArray As Variant
    Dim v As Long
    Dim s As String
    Dim i As Long

s = ""

MyArray = Array(400, 300, 200, 100, 90, 80, 70, 60, 50, 40, 30, 20, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
MyaArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", _
"י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
v = Val(ftnoteNumber)
Do While v > 0
If v = 15 Or v = 16 Then
s = s & "ט"
v = v - 9
End If
  For i = 0 To UBound(MyArray)
    If v >= MyArray(i) Then
      s = s & MyaArray(i)
      v = v - MyArray(i)
      Exit For
    End If
  Next i
Loop

If s = "רצח" Then s = "רחצ"
If s = "רע" Then s = "ער"
If s = "רעב" Then s = "ערב"
If s = "שד" Then s = "דש"
If s = "שמד" Then s = "שדמ"
If s = "תשמד" Then s = "תדשם"
If s = "רעה" Then s = "ערה"
If s = "רעד" Then s = "עדר"

ConvertToHebrew = s

End Function

[pcinfogmach]

כדי להקטין את המספור יש להחליף שורה זו

outputNumber = outputNumber + plusNumber

ב-

outputNumber = outputNumber - plusNumber

[שמואל ש.]

@pcinfogmach מה זה לשון נקיה?

[pcinfogmach]

@שמואל-ש כתב בבקשת מידע | המרת אותיות למספרים באקסל:

מה זה לשון נקיה?

לשון נקיה זה 'ערב' במקום 'רעב' או 'ער' במקום 'רע' וכל כיו"ב

[ח.ש.]

@pcinfogmach
איך אני משתמש בו?

[pcinfogmach]

@ח-ש
סגור את אקסל

העתק קובץ זה
הגדלת מספור עברי.xltm
אל תוך תיקייה זו

%AppData%\Microsoft\Word\STARTUP

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

[ח.ש.]

@pcinfogmach כתב בבקשת מידע | המרת אותיות למספרים באקסל:

%AppData

סליחה אך אינני מוצא תיקייה זו.
היכן היא נמצאת?

[pcinfogmach]

@ח-ש
העתק את הכתובת של התיקייה אל תוך השורה העליונה של סייר הקבצים ולחץ אנטר

או על ידי 'הפעל'

[ח.ש.]

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