查找和替換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

根據新信息，我將其簡化。

希望能幫助到你