一致格式化单元格：

Question

我试图用这种方式做到这一点。它有效，新文本被添加到原始文本，但原始文本的格式（粗体等）丢失！

submit()

是否有任何简单的解决方案如何保持格式化？

Answer 1

这可能会起到作用：

ActiveSheet.Cells(ActiveCell.Row, 13).Copy
ActiveSheet.Cells(ActiveCell.Row, 13).Value = ActiveSheet.Cells(ActiveCell.Row, 13) & vbCrLf & Date
ActiveSheet.Cells(ActiveCell.Row, 13).PasteSpecial Paste:=xlPasteFormats

对于换行符，要显示要么确保目标单元格已启用换行符，要么按代码设置它，如下所示：

ActiveSheet.Cells(ActiveCell.Row, 13).WrapText = True

编辑：对于另一种方法，请查看@Masouds优秀答案。

编辑：这会在保留所有其他格式的同时添加文字：

With ActiveCell
    .Characters(Len(.Value) + 1).Insert vbCrLf & Date
End With

请注意，添加的文本填充的格式为单元格中的最后一个字符。

Answer 2

一致格式化单元格：

如果您不想使用复制/粘贴，可以使用以下内容：

With ActiveSheet.Cells(ActiveCell.Row, 13)

    With .Font
     f_name = .Name
     f_style = .Style
     f_size = .Size
     f_italic = .Italic
     f_line = .Underline
    End With

  .Value = ActiveSheet.Cells(ActiveCell.Row, 13) & vbCrLf & Date

  With .Font
     .Name = f_name
     .Style = f_style
     .Size = f_size
     .Italic = f_italic
     .Underline = f_line
  End With

End With

它可能比复制/粘贴更快，但在编写脚本方面更加费力（以艰难的方式，但正确的方式）。

部分格式化单元格：

对于部分格式化的单元格，它有点难度。你需要遍历每个角色。否则，将返回Null。

With ActiveSheet.Cells(ActiveCell.Row, 13)

For i = 1 To Len(.Value)

   With .Characters(i, 1).Font
     f_name = .Name
     f_style = .Style
     f_size = .Size
     f_italic = .Italic
     f_line = .Underline
   End With

Next i

  .Value = ActiveSheet.Cells(ActiveCell.Row, 13) & vbCrLf & Date

For i = 1 To Len(.Value)

   With .Characters(i, 1).Font
     .Name = f_name
     .Style = f_style 
     .Size = f_size 
     .Italic = f_italic
     .Underline = f_line 
   End With

Next i

End With

后者满足您所需的输出。

Answer 3

到目前为止我发现的唯一方法是可靠地工作（但非常慢）是保存每个字符的格式，附加文本并重新应用格式。

我尝试通过将格式重新应用于字符串来优化代码，但我不知道这是否比对每个字符应用格式更快。</ p>

例如

call pcExcelCellAppendText(sh.cell(r,3), "start")
call pcExcelCellAppendText(sh.cell(r,3), "red & bold", rgb(&H80,0,0), true)
call pcExcelCellAppendText(sh.cell(r,3), "green", rgb(0,&H80,0))

Sub pcExcelCellAppendText(cell As Excel.Range, word As String, Optional wordColor As Long = 0, Optional wordBold As Boolean = False, Optional wordStrike As Boolean = False)

  ' append word to excel cell

  ' copy current cell formatting

  If cell Is Nothing Then Exit Sub  ' cell not exists

  Dim n As Integer: n = cell.Characters.Count
  Dim s As Integer: s = n + Len(word)

  Dim   clen() As Long:    ReDim   clen(1 To s) ' length of characters with same font  
  Dim  color() As Long:    ReDim  color(1 To s)
  Dim   bold() As Boolean: ReDim   bold(1 To s)
  Dim strike() As Boolean: ReDim strike(1 To s)

  Dim c As Integer
  Dim p As Integer: p = 1

  for c = 1 to n
    With cell.Characters(c, 1).Font
      If          .color =  color(p) _
      and          .bold =   bold(p) _
      and .StrikeThrough = strike(p) Then  ' same format
          clen(p) = clen(p) + 1                ' increase length of characters with same format
      Else                                     ' change of format
                p = c                          ' new base or start of character string
          clen(p) = 1
         color(c) = .color
          bold(c) = .bold
        strike(c) = .StrikeThrough
      End If
    End With

  Next

  ' append word - this resets all formatting so we need to put formatting back

  cell = cell & word

  ' re-apply previous formatting

  c = 1
  While c <= n                         
    With cell.Characters(c, clen(c)).Font   ' restore character font
              .color =  color(c)
               .bold =   bold(c)
      .StrikeThrough = strike(c)
    End With
    c = c + clen(c)
  Wend

  ' highlight appended word

  With cell.Characters(c, Len(word)).Font  ' apply specified font to new text
            .color = wordColor
             .bold = wordBold
    .StrikeThrough = wordStrike
  End With

End Sub

Answer 4

我正在研究此问题，并在另一个名为OzGrid的论坛上找到了解决方案。
（在https://www.ozgrid.com/forum/index.php?thread/79710-preserve-cells-word-formatting-concatenating-text/处查看线程）

在保持以前的格式的同时追加到单元格的一种简单方法是使用.insert方法。它会从指定的字符开始插入新内容，因此您需要首先确定要添加的字符的索引号。

Sub AppendToCell()

PreCellCont = ActiveCell.Value   'Stores the content previously in the cell.
ActiveCell.Characters(Len(PreCellCont) + 1).Insert "(Your New Content Here)"
'Inserts new content starting at the character one beyond the number of characters previously in the cell

End Sub

此短代码存储单元格的先前内容，以便我们确定长度。然后，它将新内容插入到该字符开始的位置，该字符将紧随该单元格中先前内容的最后一个字符。该索引由先前内容的长度加1给出。

我希望它能够像帮助我一样帮助别人！

如何将文本附加到单元格并保持格式？

4 个答案:

一致格式化单元格：

部分格式化单元格：