Sub sdss()
Dim i As Long, n As Long
k = Len(Cells(2, 1))
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2:E" & lr + 1).ClearContents
For n = 2 To lr
For i = 1 To k
x = Mid(Cells(n, 1), i, 1)
If x Like "[а,и,с,ъ]" Then
Z = 1
ElseIf x Like "[б,й,т,ы]" Then
Z = 2
ElseIf x Like "[в,к,у,ь]" Then
Z = 3
ElseIf x Like "[г,л,ф,э]" Then
Z = 4
ElseIf x Like "[д,м,х,ю]" Then
Z = 5
ElseIf x Like "[е,н,ц,я]" Then
Z = 6
ElseIf x Like "[ё,о,ч]" Then
Z = 7
ElseIf x Like "[ж,п,ш]" Then
Z = 8
ElseIf x Like "[з,р,щ]" Then
Z = 9
Else
Z = ""
End If
If x Like "[а,у,о,ы,и,э,я,ю,ё,е]" Then
Cells(n, 2) = Cells(n, 2) & x
Cells(n, 3) = Cells(n, 3) & Z
ElseIf x Like "[б,в,г,д,ж,з,й,к,л,м,н,п,р,с,т,ф,х,ц,ч,ш,щ]" Then
Cells(n, 4) = Cells(n, 4) & x
Cells(n, 5) = Cells(n, 5) & Z
End If
Next i
Next n
End Sub
|