Question

如何修改以下代码，以便不仅复制值，还复制字体样式，例如大胆还是不大胆。感谢

Private Sub CommandButton1_Click()
Dim i As Integer
Dim a As Integer
a = 15
For i = 11 To 32
  If Worksheets(1).Cells(i, 3) <> "" Then
    Worksheets(2).Cells(a, 15) = Worksheets(1).Cells(i, 3).Value
    Worksheets(2).Cells(a, 17) = Worksheets(1).Cells(i, 5).Value
    Worksheets(2).Cells(a, 18) = Worksheets(1).Cells(i, 6).Value
    Worksheets(2).Cells(a, 19) = Worksheets(1).Cells(i, 7).Value
    Worksheets(2).Cells(a, 20) = Worksheets(1).Cells(i, 8).Value
    Worksheets(2).Cells(a, 21) = Worksheets(1).Cells(i, 9).Value
    a = a + 1
  End If
Next i

Answer 1

您可以尝试使用复制/粘贴，而不是直接设置值，而不是：

Worksheets(2).Cells(a, 15) = Worksheets(1).Cells(i, 3).Value

试试这个：

Worksheets(1).Cells(i, 3).Copy
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteFormats
Worksheets(2).Cells(a, 15).PasteSpecial Paste:=xlPasteValues

要将字体设置为粗体，您可以保留现有的分配并添加：

If Worksheets(1).Cells(i, 3).Font.Bold = True Then
  Worksheets(2).Cells(a, 15).Font.Bold = True
End If

Answer 2

继jpw后，最好将他的解决方案封装在一个小的子程序中，以节省大量的代码：

Private Sub CommandButton1_Click()
Dim i As Integer
Dim a As Integer
a = 15
For i = 11 To 32
  If Worksheets(1).Cells(i, 3) <> "" Then
    call copValuesAndFormat(i,3,a,15)        
    call copValuesAndFormat(i,5,a,17) 
    call copValuesAndFormat(i,6,a,18) 
    call copValuesAndFormat(i,7,a,19) 
    call copValuesAndFormat(i,8,a,20) 
    call copValuesAndFormat(i,9,a,21) 
    a = a + 1
  End If
Next i
end sub

sub copValuesAndFormat(x1 as integer, y1 as integer, x2 as integer, y2 as integer)
  Worksheets(1).Cells(x1, y1).Copy
  Worksheets(2).Cells(x2, y2).PasteSpecial Paste:=xlPasteFormats
  Worksheets(2).Cells(x2, y2).PasteSpecial Paste:=xlPasteValues
end sub

（我目前的位置没有Excel，所以请原谅未经测试的错误）

Answer 3

Microsoft Excel VBA文档中的此页面对我有帮助：https://docs.microsoft.com/en-us/office/vba/api/excel.xlpastetype

它提供了很多选项来自定义粘贴方式。例如，您可以 xlPasteAll （可能是您要查找的内容），或者 xlPasteAllUsingSourceTheme ，甚至 xlPasteAllExceptBorders 。

Answer 4

在OzGrid上由亚伦·伯德（Aaron Blood）先生提供了这一点-简单易懂，行之有效。

Code:
Cells(1, 3).Copy Cells(1, 1)
Cells(1, 1).Value = Cells(1, 3).Value

但是，我有点怀疑您只是向我们提供了一个过于简化的示例来提出问题。如果您只想将格式从一个范围复制到另一个范围，则如下所示...

Code:
Cells(1, 3).Copy
    Cells(1, 1).PasteSpecial (xlPasteFormats)
    Application.CutCopyMode = False

VBA复制单元格的值和格式

4 个答案: