繁体   English   中英

Excel VBA复制单元格格式设置为范围

[英]Excel VBA copy cell formatting to range

我正在使用条件格式创建宏。 宏的用途是更改列A至M中单元格的格式(单元格颜色和文本字体(粗体/斜体/ ...)和大小),具体取决于列M的值。

到目前为止,我定义了5个条件并更改了M列的单元格的条件格式,但是到目前为止,我似乎无法使用PasteSpecial命令复制这些格式。

简而言之:单元格A3至M3的格式应与N3相同,A4至M4的格式应与N4相同,依此类推。

下面包含VBA,在此先感谢!

Sub VoorwaardelijkeOpmaak()
'
' VoorwaardelijkeOpmaak Macro
'
' Sneltoets: Ctrl+Shift+Z
'
If ActiveSheet.Name <> "gedetailleerde meetstaat" Then
    MsgBox "Deze macro kan alleen in het werkblad 'gedetailleerde meetstaat' worden toegepast"
Else
Dim rg As Range
Dim cond1 As FormatCondition, cond2 As FormatCondition, cond3 As FormatCondition, cond4 As FormatCondition, cond5 As FormatCondition
Set rg = Range("N3", Range("N3").End(xlDown))

'clear any existing conditional formatting
rg.FormatConditions.Delete

'define the rule for each conditional format
Set cond1 = rg.FormatConditions.Add(xlCellValue, xlEqual, "1")
Set cond2 = rg.FormatConditions.Add(xlCellValue, xlEqual, "2")
Set cond3 = rg.FormatConditions.Add(xlCellValue, xlEqual, "3")
Set cond4 = rg.FormatConditions.Add(xlCellValue, xlEqual, "4")
Set cond5 = rg.FormatConditions.Add(xlCellValue, xlEqual, "5")

'define the format applied for each conditional format
With cond1
.Font.Color = RGB(0, 0, 0)
.Font.Bold = True
End With

With cond2
.Font.Color = RGB(128, 0, 0)
.Font.Bold = True
End With

With cond3
.Font.Color = RGB(255, 0, 0)
.Font.Bold = True
End With

With cond4
.Font.Color = RGB(0, 176, 80)
.Font.Bold = True
End With

With cond5
.Font.Color = RGB(31, 73, 125)
.Font.Bold = True
End With

Range("N3", Range("N3").End(xlDown)).Select
Selection.Copy
Range("A3:M3", Range("A3:M3").End(xlDown)).Select
Selection.PasteSpecial (xlPasteFormats)

End If

End Sub

您的代码对我来说很好(即使N列的行数比AM差)。

您是否尝试过在工作表上清除所有条件格式?

Sub VoorwaardelijkeOpmaak()
'
' VoorwaardelijkeOpmaak Macro
'
' Sneltoets: Ctrl+Shift+Z
'
If ActiveSheet.Name <> "gedetailleerde meetstaat" Then
    MsgBox "Deze macro kan alleen in het werkblad 'gedetailleerde meetstaat' worden toegepast"
Else
Dim rg As Range
Dim cond1 As FormatCondition, cond2 As FormatCondition, cond3 As FormatCondition, cond4 As FormatCondition, cond5 As FormatCondition
Set rg = Range("N3", Range("N3").End(xlDown))

For Each cell In rg

If cell.Value = "1" Then
cell.Font.Color = RGB(128, 0, 0)
cell.Font.Bold = True

ElseIf cell.Value = "2" Then
cell.Font.Color = RGB(128, 0, 0)
cell.Font.Bold = True


ElseIf cell.Value = "3" Then
cell.Font.Color = RGB(255, 0, 0)
cell.Font.Bold = True


ElseIf cell.Value = "4" Then
cell.Font.Color = RGB(0, 176, 80)
cell.Font.Bold = True


ElseIf cell.Value = "5" Then
cell.Font.Color = RGB(31, 73, 125)
cell.Font.Bold = True

End If


Next



Range("N3", Range("N3").End(xlDown)).Select
Selection.Copy
Range("A3:M3", Range("A3:M3").End(xlDown)).Select
Selection.PasteSpecial (xlPasteFormats)

End If

End Sub

您不能摆脱条件格式吗?

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM