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

[ח.ש.]

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

[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
ישר כח גדול זה עובד ממש נפלא.
תבורך מפי עליון בכל הברכות.