表格操作系列——取得表格某一列不重复的内容

表格操作系列

八、取得表格某一列不重复的内容

在编程时，经常会需要将某一列中不重复的数据取出，填充到下拉列表中，或是计算取出数据的个数。下面这个函数可以实现按一定条件取出给定列名称的不重复数据。
本函数仅提供了简单的条件判断，只支持单一字段的某些简单判断，更复杂的判断请大家根据自己的需要进行优化。

函数代码

Public Function GetNoRepetition(Fie As String, Optional CriStr As String = "", Optional Sh As String = "当前表") As Variant
'取得某一列不重复的内容
Dim d As Object
Dim i As Integer
Dim j As Integer
Dim FieCol As String
Dim CriCol As String
Dim Cri() As String
Dim CriOp As String
Dim Oper() As String
    'Dim MyCol As New Collection
    'MyCol.Add Item:=Cells(i, 1), Key:=CStr(.Cells(i, 1))

On Error Resume Next
If Sh = "当前表" Or Sh = "" Then Sh = ActiveSheet.Name
Set d = CreateObject("scripting.dictionary")
d.comparemode = vbTextCompare        '采用文本的比较方式，不分大小写
Oper = Split("<>,>=,<=,=,>,<", ",")
With Sheets(Sh)
    FieCol = .Range("1:1").Find(Fie, lookat:=xlWhole).Column
    If FieCol = "" Then GetNoRepetition = "指定的字段未找到": Exit Function
    FieCol = Chr(.Range("1:1").Find(Fie, lookat:=xlWhole).Column + 64)
    If CriStr = "" Then
    For i = 2 To .Range(FieCol & "1").End(xlDown).Row
        d(CStr(.Range(FieCol & i).Value)) = CStr(.Range(FieCol & i).Value)
    Next
    Else
        For j = 0 To UBound(Oper)
            If InStr(1, CriStr, Oper(j)) > 0 Then
                Cri = Split(CriStr, Oper(j))
                CriOp = Oper(j)
                Exit For
            End If
        Next
        If CriOp = "" Then getnorepetion = "运算符错误": Exit Function
        CriCol = .Range("1:1").Find(Cri(0), lookat:=xlWhole).Column
        If CriCol = "" Then GetNoRepetition = "条件字段未找到": Exit Function
        CriCol = Chr(.Range("1:1").Find(Cri(0), lookat:=xlWhole).Column + 64)
        For i = 2 To .Range(FieCol & "1").End(xlDown).Row
            Select Case CriOp
            Case "="
                If .Range(CriCol & i) = Cri(1) Then d(CStr(.Range(FieCol & i).Value)) = CStr(.Range(FieCol & i).Value)
            Case "<>"
                If .Range(CriCol & i) <> Cri(1) Then d(CStr(.Range(FieCol & i).Value)) = CStr(.Range(FieCol & i).Value)
            Case "<="
                If .Range(CriCol & i) <= Cri(1) Then d(CStr(.Range(FieCol & i).Value)) = CStr(.Range(FieCol & i).Value)
            Case ">="
                If .Range(CriCol & i) >= Cri(1) Then d(CStr(.Range(FieCol & i).Value)) = CStr(.Range(FieCol & i).Value)
            Case "<"
                If .Range(CriCol & i) < Cri(1) Then d(CStr(.Range(FieCol & i).Value)) = CStr(.Range(FieCol & i).Value)
            Case ">"
                If .Range(CriCol & i) > Cri(1) Then d(CStr(.Range(FieCol & i).Value)) = CStr(.Range(FieCol & i).Value)
            End Select
        Next
        
    End If
End With
GetNoRepetition = Application.Transpose(d.Keys)
End Function

数据表样子

调用例子

Sub test()
aa = GetNoRepetition("姓名", "分数>60")
Range("f2").Resize(UBound(aa)) = aa
aa = GetNoRepetition("科目")
Range("e2").Resize(UBound(aa)) = aa
End Sub

表格操作系列未完，待续！

——专注办公软件的二次开发及培训，你有问题，我有思路！
——微博、微信、CSDN同号：w_dexu。
——转载请注明出处！
扫码加微信