Excelmacros的上标？

我在Excel中有以下数据：

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

我正在寻找一个macros来改变^符号后的文字上标，同时也删除^符号。 我以为我已经find了这个网站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

不知道你怎么做这个没有^也许上标每个字母直接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 

Answer 2

该代码将在所选范围内创build字母的上标，这意味着^符号不是必需的。

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