Страницы: 1
RSS
Удаление китайского
 
Добрый день,
есть такой макрос для удаления китайского из ячеек с англо-китайскими названиями, НО при его запуске возникает ошибка Runtime error 9, Subscript out of range и при дебаге дает ссылку на Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Что не так в макросе?
Задача стоит - удалить все китайские символы из китайско-английского текста в таблицах с цифрами, чтобы остался только анг. с цифрами в табл

Sub foo()Dim i As Long, x As Long, LastRow As Long
Dim StrVal As String
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
'get the last row with data on Column I, amend to whichever column you are using

For i = 1 To LastRow 'loop from row 1 to last on Column I
   For x = 1 To Len(ws.Cells(i, "I")) 'loop through characters in each cell
       StrVal = Mid(ws.Cells(i, "I"), x, 1)
       If IsLetter(StrVal) = False Then 'check if character is valid in English
           ws.Cells(i, "I") = Replace(ws.Cells(i, "I"), StrVal, " ") 'if not replace with a space
       End If
   Next x
   ws.Cells(i, "I") = Trim(ws.Cells(i, "I")) 'trim extra spaces from cell
Next i
End Sub

Function IsLetter(strValue As String) As Boolean
'function to check whether character is between [A-Z], [a-z], [0-9], Comma, Apostrophe and Periods.
       Select Case Asc(strValue)
           Case 65 To 90, 97 To 122, 48 To 57, 39, 44 To 46
               IsLetter = True
           Case Else
               IsLetter = False
       End Select
End Function
 
В макросе все так, а вот в файле, думаю, нет.
 
fynjy80, код следует оформлять соответствующим тегом: ищите такую кнопку (см. скрин) и исправьте своё сообщение.
 
на таком вот примере
 
Цитата
fynjy80 написал:
Что не так в макросе?
в макросе все нормально, вот только в книге нет листа с именем "Sheet1"
нужно привести книгу в соответствие макросу или макрос в соответствие книге
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Мне кажется, названию темы более соответствует следующий макрос (удаляет не только китайские иероглифы):
Код
Sub test()
  Dim cell As Range, s As String, i As Long
  For Each cell In ActiveSheet.UsedRange.Cells
    If Not cell.HasFormula And Len(cell.Value) > 0 And VarType(cell.Value) = vbString Then
      s = cell.Value
      For i = 1 To Len(s)
        If AscW(Mid(s, i, 1)) < 0 Or AscW(Mid(s, i, 1)) >= 16384 Then
          Mid(s, i) = " "
        End If
      Next i
      cell.Value = Application.Trim(s)
    End If
  Next cell
End Sub

Пожалуйста, исправьте #1 в соответствии с #3.
Владимир
Страницы: 1
Наверх