使用 VBA/Python 在 Excel 中格式化和修改字符串答案

【问题标题】：Format and modify strings in Excel using VBA/Python使用 VBA/Python 在 Excel 中格式化和修改字符串
【发布时间】：2018-10-30 14:20:02
【问题描述】：

我正在尝试编写一个 VBA 脚本，该脚本通过一列单元格和一个，在 html <u></u> 标签和两个之间的文本下划线，然后从文本中删除这些标签。单元格内部可能有多个标签，后面有两个其他文本，或者根本没有标签。

到目前为止，我已经能够让脚本在标签之间添加下划线，但是当我尝试删除它们时，没有任何效果（有时没有任何改变，有时标签带有下划线等）。为简洁起见，我省略了输入/输出示例，并希望我的代码存在明显的问题，但可应要求提供。

尝试使用 VBA 解决此问题最初源于我无法在 Python 中执行此操作，因为对象模型仅与单元格一样低，而不是单元格的内容。任何使用 Python 来执行此操作的解决方案也将不胜感激！

非常感谢您的帮助！如果还有什么可以帮助大家的，请告诉我！

Sub PleaseUnderline()
'Holds the content between the tags
Dim s As String
'Holds the row number of the active cell
Dim a As Integer
'Holds the location of the beginning of the open tag
Dim b As Integer
'Holds the location of the beginning of the close tag
Dim e As Integer
Dim holder As String
    'Select the last cell in column A and make it the active cell
    Range("A" & ActiveCell.SpecialCells(xlLastCell).Row).Select
    For a = ActiveCell.Row To 1 Step -1
        Range("A" & a).Select
        holder = Range("A" & a).Value
        s = ""
        b = 1
        e = 1
        Do
            b = InStr(b, ActiveCell, "<u>")
            If b = 0 Then Exit Do
            e = b + 1
            e = InStr(e, ActiveCell, "</u>")
            If e = 0 Then
                Exit Do
            Else
                s = Mid(ActiveCell, b + 3, e - b - 3)
            End If
            holder = Replace(holder, "<u>", "", 1, 1)
            holder = Replace(holder, "</u>", "", 1, 1)
            Worksheets("Sheet").Range("A" & a).Value = holder
            ActiveCell.Characters(b, Len(s)).Font.Underline = True
            b = e + 1
        Loop
    Next a
End Sub

【问题讨论】：

可以获取单元格的值，只需要先引用sheet对象即可。

标签： python excel vba python-3.x openpyxl

【解决方案1】：

稍作修改，但这对我有用。我认为问题在于您在起点 (b + 3) 中添加了 3，而您不需要在起点添加 3，因为您已经从其前面删除了 <u>，因此无需抵消 3字符。

Sub PleaseUnderline()

Dim i As Long, j As Long
Dim startpoint As Long, endpoint As Long
Dim holder As String

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

    If InStr(Cells(i, 1).Value, "<u>") > 0 Then
        For j = 1 To Len(Cells(i, 1).Value)
            If Mid(Cells(i, 1).Value, j, 3) = "<u>" Then
                startpoint = j
            End If

            If Mid(Cells(i, 1).Value, j, 4) = "</u>" Then
                endpoint = j
            End If
        Next j

        holder = Cells(i, 1).Value
        holder = Replace(holder, "<u>", "")
        holder = Replace(holder, "</u>", "")
        Cells(i, 1).Value = holder
        Cells(i, 1).Characters(startpoint, endpoint - startpoint - 3).Font.Underline = True

    End If

Next i

End Sub

【讨论】：

【解决方案2】：

这对我有用：

Sub Tester()
    DoTags ActiveSheet.Range("A1")
End Sub

Sub DoTags(c As Range)

    Dim s As Long, e As Long, l As Long, arrTags, tag

    arrTags = Array("b", "i", "u")

    For Each tag In arrTags

        Positions c.Value, tag, s, e

        Do While s > 0 And e > 0
            With c.Characters(s + Len(tag) + 2, e - s).Font
                Select Case LCase(tag)
                    Case "u": .Underline = True
                    Case "b": .Bold = True
                    Case "i": .Italic = True
                End Select
            End With
            c.Characters(e, Len(tag) + 3).Delete '<<delete end tag first...
            c.Characters(s, Len(tag) + 2).Delete
            Positions c.Value, tag, s, e
        Loop

    Next tag
End Sub

'set start and end positions of a tag in a string
Sub Positions(txt As String, tag, ByRef s As Long, ByRef e As Long)
    e = 0: s = 0
    s = InStr(1, txt, "<" & tag & ">", vbTextCompare)
    If s > 0 Then e = InStr(s, txt, "</" & tag & ">", vbTextCompare)
End Sub

编辑：由于您的某些内容似乎对于上述方法来说可能太长了，这是一种替代方法（通用 HTML >> 格式化文本转换）

Sub Tester()
    Dim c As Range
    For Each c In ActiveSheet.Range("A2:C2").Cells
        HTMLtoFormattedText c
    Next c
End Sub

Private Sub HTMLtoFormattedText(c As Range)

    Dim objData As DataObject 'reference to "Microsoft Forms 2.0 Object Library"
    Set objData = New DataObject

    objData.SetText "<HTML>" & c.Text & "</HTML>"
    objData.PutInClipboard

    c.Parent.Activate
    c.Offset(1, 0).Select
    c.Parent.PasteSpecial Format:="Unicode Text"

End Sub

【讨论】：

适用于我的大部分文档，但因以下错误而失败：snag.gy/JKCSnN.jpg 触发此错误的第一个单元格的内容是：“1 wǒ, ní féi , chū shēng..." 关于如何解决它的任何想法？
我只测试了简单的ascii文本，所以可能与双字节字符有关？
也许吧？我的表格的其余部分是中文的，但它与这些单元格配合得很好。单步执行，看起来它实际上在引发此错误之前成功地强调了下划线。还有其他想法吗？ '^_^ 顺便感谢您的宝贵时间！
你能分享一个包含一些触发该错误的示例内容的文件吗？我可以看看。
当然！这是：drive.google.com/file/d/1EcvTPdpdUPE1ta-uuPSqKM0-_2WyYuwb/…