Question

我想知道是否有人遇到类似的事情。

我在Excel列中有一个列表，在文本中插入了斜体。类似的东西：

第一行： Calidris pugnax 的分布已减少

第二排： Hydrotaea glabricula 不再是受威胁的物种

第三行：将实施 Peltigera lepidophora 的计划

第四排： Usnea silesiaca 现已灭绝

...

我需要在Excel中使用一些VBA代码获得如下内容：在斜体之前和之后插入这些标记。

第一行：＆lt; 1＆gt; Calidris pugnax＆lt; 2＆gt;的分布。已减少

第二行：＆lt; 1＆gt; Hydrotaea glabricula＆lt; 2＆gt;不再是受威胁的物种

第三行：＆lt; 1＆gt; Peltigera lepidophora＆lt; 2＆gt;的方案。将实施

第四行：＆lt; 1＆gt; Usnea silesiaca＆lt; 2＆gt;现已灭绝

...

你知道怎么做吗？这将在仅识别标签的网站中使用（＆lt; 1＆gt;和＆lt; 2＆gt;仅用于说明我需要的内容）而不用斜体。

此致

DASCO

Answer 1

你可以使用这样的例程：

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

Answer 2

我认为您无法通过Excel中的VBA获取有关部分单元格文本的字体信息。我可以想到一个解决方法。

将列复制到MS Word
录制宏来执行
使用Word的高级查找搜索格式设置为Italics
找到下一个匹配的文本，Word将选择斜体文本，替换为＆lt; 1＆gt;选定的文本＆lt; 2＆gt;，确保将所选文本的字体设置为非斜体
重复直到找不到。

- 在Rory评论之后编辑如果使用Excel 2010以上，则可以执行此操作

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

VBA Excel更改斜体并添加<！ - 和/ - >

2 个答案: