欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  Office

VBA判断单元格内容格式、颜色、合并单元格及返回数值

程序员文章站 2022-05-22 13:12:15
一、判断数值的格式 '1 判断是否为空单元格   Sub d1()      [b1] = ""...

一、判断数值的格式

'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