Excel中添加自定义函数和过程

下面时一个将字符串表示的年，例如20080812转换为2008-08-12的函数：

Function toDate(S As String) As String
    Dim I%, L%
    I = Len(S)
    If I <> 8 Then
        MsgBox ("please check " + S)
        toDate = "Error"
    Else
        toDate = Mid(S, 1, 4) + "-"
 
        If Mid(S, 5, 1) = 0 Then
            toDate = toDate + Mid(S, 6, 1) + "-"
        Else
            toDate = toDate + Mid(S, 5, 2) + "-"
        End If
 
        If Mid(S, 7, 1) = 0 Then
            toDate = toDate + Mid(S, 8, 1)
        Else
            toDate = toDate + Mid(S, 7, 2)
        End If
 
    End If
End Function

和上面类似的程序，通过身份证号获得生日。

Function CardToBirth(Card As String) As String

    If Len(Card) = 15 Then
        CardToBirth = "19" & Mid(Card, 7, 2) & "-" & Mid(Card, 9, 2) & "-" & Mid(Card, 11, 2)
    ElseIf Len(Card) = 18 Then
        CardToBirth = Mid(Card, 7, 4) & "-" & Mid(Card, 11, 2) & "-" & Mid(Card, 13, 2)
    End If
    

End Function

下面函数检查指定列中重复的行，通过提示框来显示重复行号。

Function checkDuplicate(C1 As Integer)

    Dim I%, J%, Line

    checkDuplicate = "No"

    Line = ActiveSheet.UsedRange.Rows.Count
    
    For I = 2 To Line
        For J = I + 1 To Line
            If Cells(I, C1) <> "" And Cells(I, C1) = Cells(J, C1) Then
                MsgBox ("Duplicate Line " & I & " and Line " & J)
                checkDuplicate = "yes"
            End If
        Next
    Next
End Function

检查两列都重复的行。

Function checkDuplicate2(C1 As Integer, C2 As Integer)

    Dim I%, J%, Line

    checkDuplicate2 = "No"

    Line = ActiveSheet.UsedRange.Rows.Count
    For I = 2 To Line
        For J = I + 1 To Line
            If Cells(I, C1) <> "" And Cells(I, C1) = Cells(J, C1) And Cells(I, C2) = Cells(J, C2) Then
                MsgBox ("Duplicate Line " & I & " and Line " & J)
                checkDuplicate2 = "yes"
            End If
        Next
    Next
    Worksheets("Sheet1").Range("A1").Interior.ColorIndex = 8
    
End Function

当重复行太多时，通过提示框显示行号显得不是很方便，比较好的办法是将重复行高亮显示。

Function不能调用操作本单元格以外的方法，例如改变其它单元格的颜色，原因显而易见。

添加过程则可以操作整个Excel文件，选择菜单：工具 → 宏 → Visual Basic编辑器，在打开的编辑器中选择菜单：插入 → 模块。重命名模块名称，在模块窗口中输入函数定义：

Sub checkDuplicate3()
    
    Dim I%, J%, Line, C1, C2, Color
    C1 = "D"
    C2 = "D"
    Color = 8

    Line = ActiveSheet.UsedRange.Rows.Count
    For I = 2 To Line
        For J = I + 1 To Line
            If Range(C1 & I) <> "" And Range(C1 & I) = Range(C1 & J) And Range(C2 & I) = Range(C2 & J) Then
                Range(C1 & I).Interior.ColorIndex = Color
                Range(C1 & J).Interior.ColorIndex = Color
                Range(C2 & I).Interior.ColorIndex = Color
                Range(C2 & J).Interior.ColorIndex = Color
            End If
        Next
    Next
    
End Sub

颜色代码： 1：黑，2：白，3：红，4：绿，5：蓝，6：黄，7：紫，8：青