使用 VBA 在 Excel 中将保留格式的单元格值从一个单元格复制到另一个单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11848986/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copying the cell value preserving the formatting from one cell to another in excel using VBA
提问by BlackCursor
In excel, I am trying to copy text from one cell to another cell in another sheet. The source cell contains formatted text (bold,underlined,different colors). But when I copy the text using VBA to the other cell, the formatting is lost.
在 excel 中，我试图将文本从一个单元格复制到另一个工作表中的另一个单元格。源单元格包含格式化文本（粗体、下划线、不同颜色）。但是当我使用 VBA 将文本复制到另一个单元格时，格式丢失了。
I know it is because excel is copying only the text value. Is there a way we can read the HTML text(rather than plain text)from a cell?
我知道这是因为 excel 只复制文本值。有没有办法从单元格中读取HTML 文本（而不是纯文本）？
I have googled this and did not get any answers. I know that if we use copy and paste methods, we can copy the formatting. E.g.
我用谷歌搜索了这个，没有得到任何答案。我知道如果我们使用复制和粘贴方法，我们可以复制格式。例如
Range("F10").Select
Selection.Copy
Range("I10").Select
ActiveSheet.Paste
But I want to do it without a copy and paste since my destination is a merged cell and not identically sized as my source cell. Is there an option available in excel VBA to do this?
但是我想在没有复制和粘贴的情况下完成它，因为我的目标是一个合并的单元格并且与我的源单元格的大小不同。excel VBA 中是否有可用的选项来执行此操作？
EDIT: I was able to solve it with the following code.
编辑：我能够使用以下代码解决它。
Range("I11").Value = Range("I10").Value
For i = 1 To Range("I10").Characters.Count
Range("I11").Characters(i, 1).Font.Bold = Range("I10").Characters(i, 1).Font.Bold
Range("I11").Characters(i, 1).Font.Color = Range("I10").Characters(i, 1).Font.Color
Range("I11").Characters(i, 1).Font.Italic = Range("I10").Characters(i, 1).Font.Italic
Range("I11").Characters(i, 1).Font.Underline = Range("I10").Characters(i, 1).Font.Underline
Range("I11").Characters(i, 1).Font.FontStyle = Range("I10").Characters(i, 1).Font.FontStyle
Next i
采纳答案by SeanC
To copy formatting:
要复制格式：
Range("F10").Select
Selection.Copy
Range("I10:J10").Select ' note that we select the whole merged cell
Selection.PasteSpecial Paste:=xlPasteFormats
copying the formatting will break the merged cells, so you can use this to put the cell back together
复制格式会破坏合并的单元格，因此您可以使用它来将单元格重新组合在一起
Range("I10:J10").Select
Selection.Merge
To copy a cell value, without copying anything else (and not using copy/paste), you can address the cells directly
要复制单元格值，而不复制任何其他内容（并且不使用复制/粘贴），您可以直接寻址单元格
Range("I10").Value = Range("F10").Value
other properties (font, color, etc) can also be copied by addressing the range object properties directly in the same way
其他属性（字体、颜色等）也可以通过以同样的方式直接寻址范围对象属性来复制
回答by Eric
Using Excel 2010 ? Try
使用 Excel 2010 吗？尝试
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
回答by scott
I prefer to avoid using select
我宁愿避免使用选择
With sheets("sheetname").range("I10")
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.font.color = sheets("sheetname").range("F10").font.color
End With
sheets("sheetname").range("I10:J10").merge
回答by Ankush agarwal
Sub CopyValueWithFormatting()
Sheet1.Range("A1").Copy
With Sheet2.Range("B1")
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
End Sub
回答by Ashok Kumar Ammineni
Copying the Bold Text From one sheet to another sheet in excel By using VBScript'Create instance Object
将粗体文本从一张工作表复制到 Excel 中的另一张工作表通过使用 VBScript'创建实例对象
Set oXL = CreateObject("Excel.application")
oXL.Visible = True
Set oWB = oXL.Workbooks.Open("FilePath.xlsx")
Set oSheet = oWB.Worksheets("Sheet1") 'Source Sheet in workbook
Set oDestSheet = oWB.Worksheets("Sheet2") 'Destination sheet in workbook
r = oSheet.usedrange.rows.Count
c = oSheet.usedrange.columns.Count
For i = 1 To r
For j = 1 To c
If oSheet.Cells(i,j).font.Bold = True Then
oSheet.cells(i,j).copy
oDestSheet.Cells(i,j).pastespecial
End If
Next
Next
oWB.Close
oXL.Quit
