Цитирование через строку в excel, заменяя Chars на алфавит

Question

Im работает с символьными строками в Excel, пытаясь заменить символы (игнорируя пробелы, тире и периоды) с помощью алфавита (по порядку). Эти строки находятся в отдельных ячейках. Я просто хочу сделать одну ячейку за раз. Пример. SG6 -099 превратится в ABC -DEF и 3F5234-42- GA превратится в ABCDEF-GH-IJ

Эти строки не будут длиннее 26 символов.

Возможно ли это?

Заранее спасибо

Answer 1

мне удалось объединить две подводные лодки (один я, а другой я нашел). Как это работает?

Function replace_Text(ByVal cel as Range) as String 


Dim editText$ 
editText = cel.Value 

Dim i&, k& 
k = 1 
For i = 1 To Len(editText) 
    If IsLetter(Mid(editText, i, 1)) Then 
     editText = WorksheetFunction.Substitute(editText, Mid(editText, i, 1), Chr$(64 + k), 1) 
     k = k + 1 
    End If 
Next i 

replace_Text = editText 
End Function 

Function IsLetter(strValue As String) As Boolean 
' https://techniclee.wordpress.com/2010/07/21/isletter-function-for-vba/ 
    Dim intPos As Integer 
    For intPos = 1 To Len(strValue) 
     Select Case Asc(Mid(strValue, intPos, 1)) 
      Case 48 To 57, 65 To 90, 97 To 122 
       IsLetter = True 
      Case Else 
       IsLetter = False 
       Exit For 
     End Select 
    Next 
End Function 

В ячейке, тип =text_Replace(A1), где A1 представляет собой клетку со строкой.

Answer 2

Это то, что я в конечном итоге использовал. Он заполняет выход в соседнюю ячейку

Ex. 080110- 0015 будет вход ABCDEF- GHIJ будет выходного

Private Sub Worksheet_Change(ByVal Target As Range) 


If Not Application.Intersect(Range("A1:A6"), Range(Target.Address)) Is Nothing Then 
Call replace_Text("A", "1") 

End If 
End Sub 

выше, как я бы назвал эту функцию.

Sub replace_Text(C As String, R As String) 


Set cel = Range(C & R) 

Dim editText$ 
editText = cel.Value 

Dim i&, k& 
k = 1 
For i = 1 To Len(editText) 
    If IsLetter(Mid(editText, i, 1)) Then 
     Select Case (InStr(editText, Chr$(64 + k)) > 0) 
     Case True 
     editText = WorksheetFunction.Substitute(editText, Mid(editText, i, 1), Chr$(64 + k), 1) 
     k = k + 1 
     Case False 
     editText = WorksheetFunction.Replace(editText, i, 1, Chr$(64 + k)) 
     k = k + 1 
     End Select 

     ElseIf IsNum(Mid(editText, i, 1)) Then 
     editText = WorksheetFunction.Substitute(editText, Mid(editText, i, 1), Chr$(64 + k), 1) 
     k = k + 1 
    End If 
Next i 

Dim cel2 

Set cel2 = Range("B" & R) 
cel2.Value = editText 


End Sub 

Function IsNum(strValue As String) As Boolean 
    Dim intPos As Integer 
    For intPos = 1 To Len(strValue) 
     Select Case Asc(Mid(strValue, intPos, 1)) 
      Case 47 To 57, 47 To 57 
       IsNum = True 
      Case Else 
       IsNum = False 
       Exit For 
     End Select 
    Next 
End Function 

Function IsLetter(strValue As String) As Boolean 
    Dim intPos As Integer 
    For intPos = 1 To Len(strValue) 
     Select Case Asc(Mid(strValue, intPos, 1)) 
      Case 65 To 90, 97 To 122 
       IsLetter = True 
      Case Else 
       IsLetter = False 
       Exit For 
     End Select 
    Next 
End Function