VBA Excel更改斜体并添加</和/> [英] VBA Excel Changing Italics and adding </ and />

问题描述

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

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

我在Excel列中有一个列表，该列表中的文字已插入斜体.像这样:

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

第一行: pulidx 的分布已减少

第二行: Hydrotaea glabricula 不再是受威胁物种

Second row: Hydrotaea glabricula is no longer a threatened species

第三行:将实施一种用于

Peltigera lepidophora 的方案

Third row: A scheme for Peltigera lepidophora will be implemented

第四行:西尼西亚乌斯尼(Usnea silesiaca)现已灭绝

...

我需要在Excel中使用一些VBA代码获得如下信息:在斜体字之前和之后插入这些标签.

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

第一行:减少了< 1> pulidax蒲甘草<2>的分布

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

第二行:< 1> Hydrotaea glabricula< 2>不再是受威胁物种

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

第三行:将实施针对< 1> Peltigera lepidophora< 2>的方案

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

第四行:< 1> Usnea silesiaca< 2>现已灭绝

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

...

您对此有任何想法吗?这将用于仅识别标记的网站(仅在此处使用< 1>和< 2>来表明我的需要)，而不使用斜体.

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.

此致

Dasco

推荐答案

您可以使用这样的例程:

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

这篇关于VBA Excel更改斜体并添加&lt;/和/&gt;的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！