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

我试着用这种简单的方式来做。 它可以工作，新文本添加到原始文本中，但原始文本的格式（粗体等）丢失

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

---

有什么简单的解决方案可以保持格式吗？

这可能会解决问题：

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 Excellent answer

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

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

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

格式一致的单元格： 如果您不想使用“复制/粘贴”，可以使用以下方法：

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

---

后者满足您所需的输出。

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

我试图通过对字符串重新应用格式来优化代码，但我不知道这是否比对每个字符应用格式更快

乙二醇

调用pcExcelCellAppendText（sh.cell（r，3），“开始”）
调用pcExcelCellAppendText（sh.cell（r，3），“红色和粗体”，rgb（&H80,0,0），true）
调用pcExcelCellAppendText（sh.cell（r，3），“绿色”，rgb（0，&H80,0））
子pcExcelCellAppendText（单元格为Excel.Range，word为字符串，可选wordColor为Long=0，可选wordBold为Boolean=False，可选wordStrike为Boolean=False）
'将word附加到excel单元格
'复制当前单元格格式
如果单元格为空，则退出子单元格不存在
作为整数的Dim n:n=cell.Characters.Count
尺寸s为整数：s=n+Len（字）
Dim clen（）等长：重拨clen（1到s）具有相同字体的字符长度
变暗颜色（）的长度：变暗颜色（1到s）
Dim bold（）为布尔值：ReDim bold（1到s）
变暗罢工（）为布尔值：重划罢工（1到s）
作为整数的Dim c
将p调整为整数：p=1
对于c=1到n
带单元格。字符（c，1）。字体
如果.color=color（p）_
and.bold=bold（p）_
和.StrikeThrough=strike（p）然后“相同格式”
clen（p）=clen（p）+1'增加相同格式字符的长度
Else的格式更改
p=c'字符串的新基或开头
克伦（p）=1
颜色（c）=.颜色
粗体（c）=.粗体
罢工（c）=罢工
如果结束
以
下一个
'追加单词-这将重置所有格式，因此我们需要重新设置格式
单元格=单元格和单词
'重新应用以前的格式
c=1
当我研究这个问题时，我在另一个叫做OzGrid的论坛上找到了一个解决方案。

（查看位于的线程）

在保持以前格式的同时附加到单元格的一种简单方法是使用.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给出

我希望这能像帮助我一样帮助别人
 对不起，这对我不起作用。我说的是部分格式（只有一些文本是粗体的），这在代码中也丢失了：-/我明白了。你到底想干什么？也许你有一个错误的方法。文本中有一些重要的信息，它们是粗体的。此函数应将当前日期附加到文本中，但前面的粗体部分应保留粗体字体。@DavidG不错，但它不插入
vbCrLf
。也包括这个。谢谢你的提示！你希望每个字符（技术上）的格式与以前相同，对吗？是的，原文中的一些重要单词是粗体的，我希望保持粗体。你可以接受下面的一个答案；
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