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