VBA Excel Changing Italics and adding [closed]

问题

I wonder if someone has ever come across with something like that.

I have a list in an Excel column which has italics inserted in the text. Something like:

First row: The distribution of Calidris pugnax has been reduced

Second row: Hydrotaea glabricula is no longer a threatened species

Third row: A scheme for Peltigera lepidophora will be implemented

Fourth row: Usnea silesiaca is now extinct

...

I need to get something like as follows using some VBA code in Excel: Insert these tags before and after the italics.

First row: The distribution of <1>Calidris pugnax<2> has been reduced

Second row: <1>Hydrotaea glabricula<2> is no longer a threatened species

Third row: A scheme for <1>Peltigera lepidophora<2> will be implemented

Fourth row: <1>Usnea silesiaca<2> is now extinct

...

Do you have any idea of how to do that? This is to be used in a website which only recognizes the tags (the <1> and <2> are used only here to make it clear what I need) and no the italics.

Regards,

Dasco

回答1:

You could use a routine like this:

Sub TagItalics()
    Dim lngStart As Long
    Dim lngFinish As Long
    Dim n As Long
    Dim rngCell As Range
    Dim rngConstants As Range

    On Error Resume Next
    Set rngConstants = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0

    If Not rngConstants Is Nothing Then
        Application.ScreenUpdating = False
        For Each rngCell In rngConstants.Cells
            lngStart = 0
            For n = 1 To Len(rngCell.Value)
                If rngCell.Characters(n, 1).Font.Italic Then
                    If lngStart = 0 Then lngStart = n
                ElseIf lngStart <> 0 Then
                    lngFinish = n
                    Exit For
                End If
            Next n
            If lngStart <> 0 Then
                rngCell.Characters(lngStart, 0).Insert "<1>"
                rngCell.Characters(lngFinish + 3, 0).Insert "<2>"
            End If
        Next rngCell
        Application.ScreenUpdating = True
    End If

End Sub

回答2:

I don't think you can get Font information about a part of the cell text via VBA in Excel. I can think of a workaround.

Copy the column to MS Word
Record a macro to do
Use the Word's advanced find to search of the text with the format set to Italics
Find the next matching text, Word would select that italic text, replace with <1> selected text <2>, make sure to set the selected text's font to non italic
Repeat until none are found.

--Edit after Rory's comment If using Excel 2010 onwards, you can do this

Sub MarkItalics()
Dim cell As Range, char As Characters, insideItalic As Boolean, content As String, newContent As String
Dim startIndex As Integer, endIndex As Integer, foundItalics As Boolean
For Each cell In Range("A1:A50")
    insideItalic = False
    foundItalics = False
    content = cell.Value
    If content <> "" Then
        For i = 1 To Len(content)
            Set char = cell.Characters(i, 1)
            If char.Font.Italic And insideItalic = False Then
                newContent = Mid(content, 1, i - 1) & ("<1>")
                startIndex = i - 1
                insideItalic = True
                foundItalics = True
            ElseIf Not char.Font.Italic And insideItalic Then
                newContent = newContent & Mid(content, startIndex + 1, i - startIndex) & "<2>"
                insideItalic = False
                endIndex = i - 1
            End If
        Next
        newContent = newContent & Mid(content, endIndex)
        If foundItalics Then cell.Value = newContent
    End If
Next
End Sub

来源：https://stackoverflow.com/questions/24646967/vba-excel-changing-italics-and-adding-and

标签

excel

vba

excel-vba

VBA Excel Changing Italics and adding </ and /> [closed]

问题

回答1:

回答2: