使用VBA將單元格值保留在Excel中保留格式從一個單元格到另一個單元格

Question

在excel中，我試圖將文本從一個單元格復制到另一個單元格中的另一個單元格。 源單元格包含格式化文本（粗體，下划線，不同顏色） 。 但是當我使用VBA將文本復制到另一個單元格時，格式化將丟失。

我知道這是因為excel只復制文本值。 有沒有辦法可以從單元格中讀取HTML文本 （而不是純文本） ？

我用Google搜索了這個並沒有得到任何答案。 我知道如果我們使用復制和粘貼方法，我們可以復制格式。 例如

Range("F10").Select
Selection.Copy
Range("I10").Select
ActiveSheet.Paste

但是我想在沒有復制和粘貼的情況下這樣做，因為我的目的地是一個合並的單元格，而且我的源單元格大小不一樣。 excel VBA中是否有可用的選項來執行此操作？

編輯：我能夠使用以下代碼解決它。

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

Answer 1

使用Excel 2010？ 嘗試

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Answer 2

要復制格式：

Range("F10").Select
Selection.Copy
Range("I10:J10").Select ' note that we select the whole merged cell
Selection.PasteSpecial Paste:=xlPasteFormats

復制格式將破壞合並的單元格，因此您可以使用它將單元格重新組合在一起

Range("I10:J10").Select
Selection.Merge

要復制單元格值而不復制任何其他內容（而不使用復制/粘貼），您可以直接處理單元格

Range("I10").Value = Range("F10").Value

其他屬性（字體，顏色等 ）也可以通過以相同方式直接尋址范圍對象屬性來復制

Answer 3

我寧願避免使用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

Answer 4

Sub CopyValueWithFormatting()
    Sheet1.Range("A1").Copy
    With Sheet2.Range("B1")
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteValues
    End With
End Sub

Answer 5

通過使用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