Vba 从单元格中提取文本内容（粗体、斜体等）

我正在尝试使用宏从Excel中提取文本内容。这是我的代码：

Dim i As Integer, j As Integer
Dim v1 As Variant
Dim Txt As String

v1 = Range("A2:C15")
For i = 1 To UBound(v1)
    For j = 1 To UBound(v1, 2)
        Txt = Txt & v1(i, j)
    Next j
    Txt = Txt & vbCrLf
Next i

MsgBox Txt

但它只显示原始字符，这意味着它不显示任何格式信息，如粗体、斜体、下划线等

我想提取文本以及格式信息

示例：这是示例文本

预期输出：这是示例文本

实际输出：这是示例文本

---

有人能解释一下代码有什么问题吗？如果有什么问题，能告诉我吗

VBA字符串不支持这样的格式设置。它将完全从范围中获取字符串。完全没有格式。如果要格式化字符串，则无法通过msgbox查看

唯一的方法是将其存储在单元格中，然后格式化单元格。但这并不会将messagebox中的输出作为格式化字符串提供

---

如果计划将字符串放入具有格式的单元格中，则需要将格式保存在某个位置，或从获取文本的单元格中复制格式。然后将格式化应用到单元格

如果不更改系统默认值，messagebox不允许格式化，这不是一种直接的方法。如果您想在提示符中显示格式化文本，那么您可能最容易创建一个userform并适当地格式化标签

例如，您可以使用以下方法确定单元格是否具有加粗字体：

Dim isBold As Boolean
isBold = v1(i, j).Font.Bold

并使用以下方法将其应用于用户表单标签字体：

label.Font.Bold = isBold

如果要输出到文本（ie.txt）文件，则无法存储任何格式信息。您希望达到的最佳效果是创建标记样式输出，其中：

If isBold Then
    txt = "<b >mytext< /b>" 'Ignore the spaces
Else
    txt = "mytext"
End If

调用

IsNull（v1（i，j）.Font.Bold）

将告诉您单元格中是否有部分FOMATT。不幸的是，您必须逐个评估字符串中的每个字符以确定粗体字符。此函数应确定在传递的

范围

对象中包含的字符串中打开或关闭粗体格式的位置，并添加适当的标记标记：

Function markup(rng As Range) As String

Dim chr As Integer
Dim isCharBold As Boolean
Dim str As String
Dim tempChar As Characters

isCharBold = False
str = ""

If IsNull(rng.Font.Bold) Then
    For chr = 1 To rng.Characters.Count
        Set tempChar = rng.Characters(chr, 1)
        If isCharBold Then
            If tempChar.Font.Bold Then
                str = str + tempChar.Text
            Else
                isCharBold = False
                str = str & "</b>" & tempChar.Text
            End If
        Else
            If tempChar.Font.Bold Then
                isCharBold = True
                str = str + "<b>" & tempChar.Text
            Else
                str = str & tempChar.Text
            End If
        End If
    Next chr
Else
    str = rng.Value
End If

markup = str

End Function

---

好的，让我们把@stucharo的算法稍微简化一点，以便扩展

Public Function getHTMLFormattedString(r As Range) As String

 isBold = False
 isItalic = False
 isUnderlined = False
 s = ""
 cCount = 0
 On Error Resume Next
 cCount = r.Characters.Count
 On Error GoTo 0

 If cCount > 0 Then

  For i = 1 To cCount

   Set c = r.Characters(i, 1)

   If isUnderlined And c.Font.Underline = xlUnderlineStyleNone Then
    isUnderlined = False
    s = s & "</u>"
   End If

   If isItalic And Not c.Font.Italic Then
    isItalic = False
    s = s & "</i>"
   End If

   If isBold And Not c.Font.Bold Then
    isBold = False
    s = s & "</b>"
   End If


   If c.Font.Bold And Not isBold Then
    isBold = True
    s = s + "<b>"
   End If

   If c.Font.Italic And Not isItalic Then
    isItalic = True
    s = s + "<i>"
   End If

   If Not (c.Font.Underline = xlUnderlineStyleNone) And Not isUnderlined Then
    isUnderlined = True
    s = s + "<u>"
   End If

   s = s & c.Text

   If i = cCount Then
    If isUnderlined Then s = s & "</u>"
    If isItalic Then s = s & "</i>"
    If isBold Then s = s & "</b>"
   End If

  Next i

 Else
  s = r.Text
  If r.Font.Bold Then s = "<b>" & s & "</b>"
  If r.Font.Italic Then s = "<i>" & s & "</i>"
  If Not (r.Font.Underline = xlUnderlineStyleNone) Then s = "<u>" & s & "</u>"
 End If

 getHTMLFormattedString = s
End Function

---

代码没有问题。它从

范围（“A2:C15”）

获取一个数组，该数组中的数据不带格式。如果需要格式化，则必须在该范围内的所有单元格上运行，并同时获取值和格式。如果您真的想获得原始的富文本内容，那么您甚至可能需要遍历单元格文本值中的所有字符。但是

MsgBox

无法输出RichText。所以主要的问题是：您将在哪里输出连接的文本？我已经尝试了

Debug.Print Txt

。但同样的结果。我需要格式化结果在其他需要格式化的系统中使用。我想将其提取并存储在文本文件中。什么样的文本文件？就像一个使用记事本的.txt文件？是的。但是我需要格式化信息。如果它是粗体文本，那么它应该是

text

我不知道从哪里开始。因为您必须检查字符串是否包含粗体字。因此，您必须创建一些内容，以便在每个字符/单词（如果可能）为粗体时检查每个字符串。如果是，则将其周围环绕一圈。我认为这是一个巨大的挑战。如果单元格A1包含部分粗体文本，感谢您的回答。这将如何处理此类案件？A1包含示例文本。那么，它是否会以示例文本的形式给出输出？我会检查它。Thanks@stucharo：算法是正确的。但是

v1（i，j）

如果给定OP的工作方式，它将不会是

范围

对象。@AxelRichter当然，我错了，我是在工作表中的单元格值上测试它的。您需要使用一个range对象来访问

Characters（）

属性，否则我相信该变量也会保存一个未格式化的字符串。我将修改答案。太好了。。谢谢你的努力。我使用了

选项Explicit

，我的电脑爆炸了，我的家被烧毁了，我的城镇被外星人袭击了，我的星球上所有的火山都燃起了爆竹。。。但当我添加

Dim isbold作为布尔值，istalic作为布尔值，is下划线作为布尔值，s$，cCount&，i&，C

时，唐纳德·特朗普承认气候变化不是“假新闻”…@Patrick Lepelletier：我在这里提供的代码永远不会是应该准备好在生产环境中使用的代码。它始终是与问题相关的最简单的工作示例，而此问题与使用

选项Explicit

无关。我的代码将显示算法，因此所有额外的东西只会干扰。需要明确的是：在生产环境中，

选项显式

是必要的。但作为一名程序员并不意味着能够复制/粘贴/运行代码，而是理解代码。

Sub OutputText()

Dim i As Integer, j As Integer
Dim rng As Range
Dim Txt As String

Set rng = Range("A2:C15")
For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        Txt = Txt & markup(rng(i, j)) & " "
    Next j
    Txt = Txt & vbCrLf
Next i

Debug.Print Txt

End Sub

Public Function getHTMLFormattedString(r As Range) As String

 isBold = False
 isItalic = False
 isUnderlined = False
 s = ""
 cCount = 0
 On Error Resume Next
 cCount = r.Characters.Count
 On Error GoTo 0

 If cCount > 0 Then

  For i = 1 To cCount

   Set c = r.Characters(i, 1)

   If isUnderlined And c.Font.Underline = xlUnderlineStyleNone Then
    isUnderlined = False
    s = s & "</u>"
   End If

   If isItalic And Not c.Font.Italic Then
    isItalic = False
    s = s & "</i>"
   End If

   If isBold And Not c.Font.Bold Then
    isBold = False
    s = s & "</b>"
   End If


   If c.Font.Bold And Not isBold Then
    isBold = True
    s = s + "<b>"
   End If

   If c.Font.Italic And Not isItalic Then
    isItalic = True
    s = s + "<i>"
   End If

   If Not (c.Font.Underline = xlUnderlineStyleNone) And Not isUnderlined Then
    isUnderlined = True
    s = s + "<u>"
   End If

   s = s & c.Text

   If i = cCount Then
    If isUnderlined Then s = s & "</u>"
    If isItalic Then s = s & "</i>"
    If isBold Then s = s & "</b>"
   End If

  Next i

 Else
  s = r.Text
  If r.Font.Bold Then s = "<b>" & s & "</b>"
  If r.Font.Italic Then s = "<i>" & s & "</i>"
  If Not (r.Font.Underline = xlUnderlineStyleNone) Then s = "<u>" & s & "</u>"
 End If

 getHTMLFormattedString = s
End Function

Sub ReplaceFormattingTags()

Dim i As Integer, j As Integer
Dim rng As Range
Dim Txt As String

Set rng = Range("A2:C15")
For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        Txt = Txt & getHTMLFormattedString(rng(i, j)) & " "
    Next j
    Txt = Txt & vbCrLf
Next i

Debug.Print Txt

End Sub