VBA判断单元格内容格式、颜色、合并单元格及返回数值（vba统计条件格式的颜色）

VBA判断单元格内容格式、颜色、合并单元格及返回数值（vba统计条件格式的颜色）

一、判断数值的格式

'1 判断是否为空单元格

Sub d1()

[b1] = ""

'If Range("a1") = "" Then

'If Len([a1]) = 0 Then

If VBA.IsEmpty([a1]) Then

[b1] = "空值"

End If

End Sub

'2 判断是否为数字

Sub d2()

[b2] = ""

'If VBA.IsNumeric([a2]) And [a2] <> "" Then

'If Application.WorksheetFunction.IsNumber([a2]) Then

[b2] = "数字"

End If

End Sub

'3 判断是否为文本

Sub d3()

[b3] = ""

'If Application.WorksheetFunction.IsText([A3]) Then

If VBA.TypeName([a3].Value) = "String" Then

[b3] = "文本"

End If

End Sub

'4 判断是否为汉字

Sub d4()

[b4] = ""

If [a4] > "z" Then

[b4] = "汉字"

End If

End Sub

'5 判断错误值

Sub d10()

[b5] = ""

'If VBA.IsError([a5]) Then

If Application.WorksheetFunction.IsError([a5]) Then

[b5] = "错误值"

End If

End Sub

Sub d11()

[b6] = ""

If VBA.IsDate([a6]) Then

[b6] = "日期"

End If

End Sub

二、设置单元格自定义格式

Sub d30()

Range("d1:d8").NumberFormatLocal = "0.00"

End Sub

三、按指定格式从单元格返回数值

'Format函数语法(和工作表数Text用法基本一致)

'Format(数值,自定义格式代码)

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'Excel中的颜色可以用两种方式获取，一种是EXCEL内置颜色，另一种是利用QBCOLOR函数返回

Sub y1()

Dim x As Integer

Range("a1:b60").Clear

For x = 1 To 56

Range("a" & x) = x

Range("b" & x).Font.ColorIndex = 3

Next x

End Sub

Sub y2()

Dim x As Integer

For x = 0 To 15

Range("d" & x + 1) = x

Range("e" & x + 1).Interior.Color = QBColor(x)

Next x

End Sub

Sub y3()

Dim 红 As Integer, 绿 As Integer, 蓝 As Integer

红 = 255

绿 = 123

蓝 = 100

Range("g1").Interior.Color = RGB(红, 绿, 蓝)

End Sub

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'单元格合并

Sub h1()

Range("g1:h3").Merge

End Sub

'合并区域的返回信息

Sub h2()

Range("e1") = Range("b3").MergeArea.Address '返回单元格所在     的合并单元格区域

End Sub

'判断是否含合并单元格

Sub h3()

'MsgBox Range("b2").MergeCells

' MsgBox Range("A1:D7").MergeCells

Range("e2") = IsNull(Range("a1:d7").MergeCells)

Range("e3") = IsNull(Range("a9:d72").MergeCells)

End Sub

'合并H列相同单元格

Sub h4()

Dim x As Integer

Dim rg As Range

Set rg = Range("h1")

Application.DisplayAlerts = False

For x = 1 To 13

If Range("h" & x + 1) = Range("h" & x) Then

Set rg = Union(rg, Range("h" & x + 1))

Else

rg.Merge

Set rg = Range("h" & x + 1)

End If

Next x

Application.DisplayAlerts = True

End Sub