Sub Convert1(a As String) Dim a1 As String Dim i As Integer For i = 1 To Len(a) k1 = Strings.AscW(Mid(a, i, 1)) If k1 > 255 Then ' код Cyrillic a1 = Strings.ChrW(k1) Else ' код Western (ANSI=Unicode) a1 = Strings.Chr$(k1) End If Mid(a, i, 1) = a1 Next i End Sub Sub mySub() 'On Error GoTo err: Dim a, i As Integer Dim ws As Worksheet Dim CEL As Range Dim abc(5148) As String Dim abc1() As String Dim j As Integer Dim c Dim b As String a = 0 For i = 1 To 26 For j = 1 To 66 a = a + 1 abc(a) = Strings.Chr(96 + i) & j Next Next For i = 1 To 26 For j = 1 To 66 a = a + 1 abc(a) = "a" & Strings.Chr(96 + i) & j Next Next For i = 1 To 26 For j = 1 To 66 a = a + 1 abc(a) = "b" & Strings.Chr(96 + i) & j Next Next If Excel.Workbooks.Count > 1 Then c = Excel.ActiveWindow.WindowState Excel.ActiveWindow.WindowState = xlMinimized For Each ws In Excel.ActiveWorkbook.Worksheets j = 0 ReDim abc1(j) For i = 1 To 5148 b = ws.Range(abc(i)).Value If Len(b) > 0 And ws.Range(abc(i)).Comment Is Nothing Then j = j + 1 ReDim Preserve abc1(j) abc1(j) = abc(i) Call Convert1(b) ws.Range(abc(i)).AddComment "OK" ws.Range(abc(i)).Value = b End If Next If j > 1 Then For i = 1 To j ws.Range(abc1(i)).Comment.Delete Next End If Next Excel.ActiveWindow.WindowState = c End If Exit Sub err: 'MsgBox err & Error & Line Excel.ActiveWindow.WindowState = c End Sub