Форматировать и изменять строки в Excel, используя VBA / Python - PullRequest
Новая
       21

Форматировать и изменять строки в Excel, используя VBA / Python

0 голосов
/ 30 октября 2018

Я пытаюсь написать скрипт 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

Ответы [ 2 ]

0 голосов
/ 30 октября 2018

Это сработало для меня: 

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
0 голосов
/ 30 октября 2018

Небольшие модификации, но у меня это сработало. Я считаю, что проблема заключается в том, что вы добавляли 3 к исходной точке (b + 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

img1

...