Надпись (R) по всей книге - VBA

Question

У меня есть книга Excel, содержащая 10-15 листов, во всей книге у меня есть несколько зарегистрированных символов товарного знака, набранных как текст в ячейках (отображается как ®). Мне нужен макрос, который может проходить через содержимое всех ячеек, найти ® и надстроить эту часть ячейки.

Я сделал черновик ниже, но получаю ошибку «Объектная переменная или с переменной блочной переменной».

Sub Superscript() 
    Application.ScreenUpdating = False 
    Dim sht As Worksheet 
    For Each sht In Worksheets 
    sht.Activate 
    Dim Match As Variant, start As Variant, pos As Long, cnt As Integer 
    With ActiveSheet 
     Set Match = .Cells.Find("®", LookIn:=xlValues, lookat:=xlPart) ' Find the first match in the active sheet 
     If Not Match Is Nothing Then 
      start = Match.Address 
      Do 
       cnt = Len(Match.Value) - Len(WorksheetFunction.Substitute(Match.Value, "®", "")) 
       pos = InStr(Match.Value, "®") 
      Do 
       Match.Characters(pos, 1).Font.Superscript = True 
       pos = InStr(pos + 1, Match.Value, "®") 
       cnt = cnt - 1 
       Loop While cnt > 0 
       Set Match = .Cells.FindNext(Match) 
      Loop While Not Match Is Nothing And Match.Address <> start 
     End If 
    End With 
    Next sht 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

Вы не можете получить ничего из Range.Find method, как только вы установили, что вы нашли что-то, если не изменить содержание достаточно существенно, что поиск не найти его снова. Фактически вы не меняете контент, просто изменяя форматирование. Проверка против адреса состоит в том, чтобы убедиться, что вы не пройдете все совпадения и не вернетесь в начале, которое вы в конце концов сделаете, но .Find никогда не будет ничем.

Sub Superscript() 
    Dim sht As Worksheet 
    Dim fnd As Range, frst As String, pos As Long, cnt As Integer 

    For Each sht In Worksheets 
     With sht 
      Set fnd = .Cells.Find(Chr(174), LookIn:=xlValues, lookat:=xlPart) ' Find the first match in the active sheet 
      If Not fnd Is Nothing Then 
       frst = fnd.Address 
       Do 
        pos = InStr(1, fnd.Value, Chr(174)) 
        Do 
         fnd.Characters(start:=pos, Length:=1).Font.Superscript = True 
         pos = InStr(pos + 1, fnd.Value, Chr(174)) 
        Loop While pos > 0 
        Set fnd = .Cells.FindNext(after:=fnd) 
       Loop While fnd.Address <> frst 
      End If 
     End With 
    Next sht 

End Sub 

Я не хотел бы видеть переменные с теми же именами, как зарезервированные слова, так что я сделал некоторые поверхностные изменения имен вара, а также.