上付き文字のExcelマクロ？

Question

私は、Excelで次のデータを持っている：

1.07 ± 0.35^a 1.21 ± 0.13^a 0.67 ± 0.31^a 1.43 ± 0.05^a

私も^シンボルを削除しながら、上付きする^記号の後にテキストを変更するマクロを探しています。私はこのサイトhttp://www.beingbrunel.com/inline-subsuper-script-in-excel-and-more/から答えを見つけたと思ったが、私はadd-inを働かせることはできない。

これは私の試みたコードですが、シガーはありません。

Sub Loop_Exampl() 
Dim Firstrow As Long 
Dim Lastrow As Long 
Dim Lrow As Long 
Dim CalcMode As Long 
Dim ViewMode As Long 

With Application 
    CalcMode = .Calculation 
    .Calculation = xlCalculationManual 
    .ScreenUpdating = False 
End With 

'We use the ActiveSheet but you can replace this with 
'Sheets("MySheet")if you want 
With ActiveSheet 

    'We select the sheet so we can change the window view 
    .Select 

    'If you are in Page Break Preview Or Page Layout view go 
    'back to normal view, we do this for speed 
    ViewMode = ActiveWindow.View 
    ActiveWindow.View = xlNormalView 

    'Turn off Page Breaks, we do this for speed 
    .DisplayPageBreaks = False 

    'Set the first and last row to loop through 
    Firstrow = .UsedRange.Cells(1).Row 
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row 

    'We loop from Lastrow to Firstrow (bottom to top) 
    For Lrow = Lastrow To Firstrow Step -1 

     'We check the values in the A column in this example 
     With .Cells(Lrow, "B") 

     With ActiveCell.Characters(Start:=2, Length:=1).Font 
      .Superscript = False 
       .Subscript = True 

End With 

End Sub 

Answer 1

このコードは^シンボルが必要とされていないことを意味し、選択した範囲の文字の上付き文字を作成します。

Sub FixFormatting() Dim c As Range Dim StartCells As Range Dim ws As Worksheet Dim intPlace As Integer Dim wsStartsProtected As Boolean

Application.ScreenUpdating = False 
On Error GoTo errorCatch 
Set StartCells = Selection 
    For Each c In Selection.Cells 
     With c 
      .Replace What:="a", Replacement:="a", LookAt:=xlPart, MatchCase:=False 
      .Replace What:="b", Replacement:="b", LookAt:=xlPart, MatchCase:=False 
      .Replace What:="c", Replacement:="c", LookAt:=xlPart, MatchCase:=False 

     End With 
     intPlace = InStr(c.Value, "a") 
     If intPlace > 0 Then 
      If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect 
      c.Characters(intPlace, 1).Font.Superscript = True 
     End If 
     intPlace = InStr(c.Value, "b") 
     If intPlace > 0 Then 
      If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect 
      c.Characters(intPlace, 1).Font.Superscript = True 
     End If 
     intPlace = InStr(c.Value, "c") 
     If intPlace > 0 Then 
      If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect 
      c.Characters(intPlace, 1).Font.Superscript = True 

     End If 
     If wsStartsProtected Then ws.Protect 
    Next 
StartCells.Parent.Activate 
StartCells.Select 
Application.ScreenUpdating = True 
Exit Sub 

errorCatch: If wsStartsProtected Then ws.Protect StartCells.Parent.Activate StartCells.Select Application.ScreenUpdating = True End Sub

Answer 2

は必ず^せずにこれを行うだろうか多分直接C =桁を次のすべての文字を上付きしませんか？

Sub tester() 

    Dim c As Range 

    For Each c In Selection.Cells 
     SuperIt c 
    Next c 

End Sub 

Sub SuperIt(rng As Range) 

    Dim s, p, e 

    s = rng.Text 
    p = InStr(s, "^") 

    If p > 0 Then 
     Do 
      e = 1 
      Do While Mid(s, p + e, 1) <> " " And p + e < Len(s) 
       e = e + 1 
      Loop 
      rng.Characters(p, 1).Delete 
      rng.Characters(p, e).Font.Superscript = True 

      s = rng.Text 
      p = InStr(s, "^") 
     Loop While p > 0 
    End If 
End Sub