查找和替换MS Excel中的下标和上标

Question

我想在excel单元格中找到所有包含下标和上标的数字和公式，并用html标签替换下标和上标。

例如。 包含² +（b ³ -c）的单元格将替换为：

 a<sup>2</sup> + (b<sup>3</sup> - c) 

非常感谢。

Answer 1

据我所试，那个总是可以的，但是第一个字符失败。 因此，如果冷杉字符是下标或上标，它将失败。

该代码用于上标情况。 对于下标情况，只需将.Font.Subscript更改为.Font.Subscript ， .Font.Superscript更改html上的任何代码（上标<sup> ）。

Sub test()
Dim ColNo, RowNo As Long
Dim Pos(500) As Integer
Dim Str(500) As String
Dim sType(500) as String
Dim NewStr As String

Set ws1 = Worksheets("Hoja1")
Set ws2 = Worksheets("Hoja2")
ws1.Activate

With ws1
    RowNo = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ColNo = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
    l = 2
    For i = 1 To ColNo
        For j = 1 To RowNo
            Pos(1) = 1
            For k = 1 To Len(.Cells(j, i).Value2) - 1
                If .Cells(j, i).Characters(k + 1, 1).Font.Superscript = True Then
                    Pos(l) = k + 1
                    sType(l) = "Sup"
                    l = l + 1
                ElseIf .Cells(j, i).Characters(k + 1, 1).Font.Subscript = True Then
                    Pos(l) = k + 1
                    sType(l) = "Sub"
                    l = l + 1
                End If
            Next
            For k = 1 To l - 1
                If Pos(k + 1) > Pos(k) Then
                    If sType(l + 1) = "Sup" Then
                        Str(2 * k) = Mid(.Cells(j, i).Value2, Pos(k), Pos(k + 1) - Pos(k))
                        Str(2 * k - 1) = Mid(.Cells(j, i).Value2, Pos(k + 1), 1)
                        Str(2 * k - 1) = "<sup>" & Str(2 * k - 1) & "</sup>"
                        NewStr = NewStr & Str(2 * k) & Str(2 * k - 1)
                    ElseIf sType(l + 1) = "Sub" Then
                        Str(2 * k) = Mid(.Cells(j, i).Value2, Pos(k), Pos(k + 1) - Pos(k))
                        Str(2 * k - 1) = Mid(.Cells(j, i).Value2, Pos(k + 1), 1)
                        Str(2 * k - 1) = "<sub>" & Str(2 * k - 1) & "</sub>"
                        NewStr = NewStr & Str(2 * k) & Str(2 * k - 1)
                    End If
                End If
            Next
            If NewStr <> "" Then
                NewStr = NewStr + Mid(.Cells(j, i).Value2, _
                                  Pos(l - 1), Len(.Cells(j, i).Value2) - Pos(l - 1))
            Else
                NewStr = .Cells(j, i).Value2
            End If
            ws2.Cells(j, i).Value2 = NewStr
            NewStr = ""
            For k = 1 To l - 1
                Pos(k) = 0
                sType(k) = ""
                Str(2 * k) = ""
                Str(2 * k - 1) = ""
            Next
            l = 2
        Next
    Next
End With

End Sub

希望能帮助到你

Answer 2

试试这个：

Sub test()
Dim ColNo, RowNo As Long
Dim NewStr As String

Set ws1 = Worksheets("q")
Set ws2 = Worksheets("q-a")
ws1.Activate

With ws1
    RowNo = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ColNo = .UsedRange.SpecialCells(xlCellTypeLastCell).Column

    For i = 1 To ColNo
        For j = 1 To RowNo
            l = 1
            NewStr = .Cells(j, i).Value2
            For k = 1 To Len(.Cells(j, i).Value2) - 1
                If .Cells(j, i).Characters(k + 1, 1).Font.Superscript = True Then
                    NewStr = Mid(NewStr, 1, k - 1 + l) & "<sup>" & Mid(.Cells(j, i) _ 
                           .Value2, k + 1, 1) & "</sup>" & Mid(.Cells(j, i).Value2, _
                                  k + 2, Len(.Cells(j, i).Value2) - (k + 1))
                    l = l + 11
                ElseIf .Cells(j, i).Characters(k + 1, 1).Font.Subscript = True Then
                    NewStr = Mid(NewStr, 1, k - 1 + l) & "<sub>" & Mid(.Cells(j, i)._ 
                            Value2, k + 1, 1) & "</sub>" & Mid(.Cells(j, i).Value2, _
                                  k + 2, Len(.Cells(j, i).Value2) - (k + 1))
                    l = l + 11
                End If
            Next
            l = 1
            For k = 1 To Len(NewStr) - 1
                If InStr(k, NewStr, "</sup><sup>", vbBinaryCompare) = k Then
                    NewStr = Mid(NewStr, 1, k - 1) & Mid(NewStr, k + 11, Len(NewStr) - (k + 10))
                ElseIf InStr(1, NewStr, "</sub><sub>", vbBinaryCompare) <> 0 Then
                    NewStr = Mid(NewStr, 1, k - 1) & Mid(NewStr, k + 11, Len(NewStr) - (k + 10))
                End If
            Next
            ws2.Cells(j, i).Value2 = NewStr
            NewStr = ""
        Next
    Next
End With

End Sub

根据新信息，我将其简化。

希望能帮助到你