VBA用文本周围的HTML粗体标记replace粗体字体

我正在尝试创buildExcel VBAmacros来查找粗体文本，并在find的文本周围添加HTML粗体标记。 例如：查找：“This bold word”和replace为：“This <b>bold</b> word”（html标签和word都需要加粗）

注意粗体文本在非粗体文本的单元格内，只有粗体文本应该被replace是非常重要的。

我也需要一个macros来转换另一种方式。 含义find有粗体字体或不带粗体字体的粗体标签（ <b></b> ），并删除标签并确保文本为粗体。

发现这个网站看起来很接近，但我不能让macros观工作。 有“ActiveDocument.Tables（1）.Select”和.Wrap = wdFindStop http://www.ozgrid.com/forum/showthread.php?t=57419问题

我还发现一个网站，可以帮助我find/replace文本，而不会丢失粗体格式，但仍不完全是我所需要的。 这也可能是我想要做的矫枉过正https://www.mrexcel.com/forum/excel-questions/524889-find-replace-loses-text-properties-formatting.html

我似乎无法find更多的在线问题。 也许这比我想象的更复杂？

我有些东西在做

 Sub removeboldaddHtml() lastrow = Range("A1").End(xlDown).Row For i = 1 To lastrow msg = "" For j = 1 To Len(Cells(i, 1)) If Range("A" & i).Characters(j, 1).Font.Bold = True Then msg = msg & Mid(Cells(i, 1), j, 1) End If Next j ' next character If msg <> "" Then Cells(i, "B").Value = "<b>" & msg & "</b>" End If Next i ' next row End Sub 

Answer 1

下面的代码是相当粗糙，不雅，和资源消耗。 但无论如何可能有帮助（对于你的问题的第一部分）。 它只会在大胆的情况下才起作用（ 对于这样的事情是不行的）。 数据在工作表“Sheet1”的A列（以下代码中只有第1到3行）。 编辑标签和标签之间的文本以粗体显示。

 Private Sub CommandButton1_Click() Dim MyStringLength As Integer Dim OriginalString As String Dim MyRow As Long Dim StartPos As Integer Dim EndPos As Integer For MyRow = 1 To 3 'Adjust to your row number StartPos = 0 EndPos = 0 MyStringLenght = Len(Worksheets("Sheet1").Cells(MyRow, 1)) For i = 1 To MyStringLenght If Worksheets("Sheet1").Cells(MyRow, 1).Characters(i, 1).Font.Bold = True Then If StartPos = 0 Then StartPos = i End If EndPos = i End If Next OriginalString = Worksheets("Sheet1").Cells(MyRow, 1) Worksheets("Sheet1").Cells(MyRow, 2) = StartPos Worksheets("Sheet1").Cells(MyRow, 3) = EndPos Worksheets("Sheet1").Cells(MyRow, 4) = Left(OriginalString, StartPos - 1) & "<b>" & Mid(OriginalString, StartPos, EndPos - StartPos + 1) & "</b>" & Right(OriginalString, MyStringLenght - EndPos) Worksheets("Sheet1").Cells(MyRow, 4).Characters(StartPos, EndPos - StartPos + 7).Font.Bold = True Next End Sub 

Answer 2

添加标签的示例：

 Sub Tester() AddTags Range("A1") End Sub Sub AddTags(c As Range) Dim p As Long, isB As Boolean Do p = p + 1 If p > Len(c.Value) Then Exit Do If c.Characters(p, 1).Font.Bold And Not isB Then 'entering a bolded section c.Characters(p, 0).Insert "<b>" c.Characters(p, 3).Font.Bold = True isB = True p = p + 3 'skip the tag you just added ElseIf Not c.Characters(p, 1).Font.Bold And isB Then 'leaving a bolded section c.Characters(p, 0).Insert "</b>" c.Characters(p, 4).Font.Bold = True isB = False p = p + 4 'skip the tag you just added End If Loop 'close any open tag If isB Then c.Characters(p, 0).Insert "</b>" End Sub