메뉴
해결

필터가 잘 안됩니다

이
이 수식
9월 26일 조회 815
Function Filtered_DB(DB, Value, Optional FilterCol, Optional ExactMatch As Boolean = False) As Variant

Dim cRow As Long
Dim cCol As Long
Dim vArr As Variant: Dim s As String: Dim filterArr As Variant: Dim Cols As Variant: Dim Col As Variant: Dim Colcnt As Long
Dim isDateVal As Boolean
Dim vReturn As Variant: Dim vResult As Variant
Dim Dict As Object: Dim dictKey As Variant
Dim i As Long: Dim j As Long
Dim Operator As String

Set Dict = CreateObject("Scripting.Dictionary")

If Value <> "" Then
cRow = UBound(DB, 1)
cCol = UBound(DB, 2)
ReDim vArr(1 To cRow)
For i = 1 To cRow
s = ""
For j = 1 To cCol
s = s & DB(i, j) & "|^"
Next
vArr(i) = s
Next

If IsMissing(FilterCol) Then
filterArr = vArr
Else
Cols = Split(FilterCol, ",")
ReDim filterArr(1 To cRow)
For i = 1 To cRow
s = ""
For Each Col In Cols
s = s & DB(i, Trim(Col)) & "|^"
Next
filterArr(i) = s
Next
End If

If left(Value, 2) = ">=" Or left(Value, 2) = "<=" Or left(Value, 2) = "=>" Or left(Value, 2) = "=<" Then
Operator = left(Value, 2)
If IsDate(Right(Value, Len(Value) - 2)) Then isDateVal = True
ElseIf left(Value, 1) = ">" Or left(Value, 1) = "<" Then
Operator = left(Value, 1)
If IsDate(Right(Value, Len(Value) - 1)) Then isDateVal = True
Else: End If

If Operator <> "" Then
If isDateVal = False Then
Select Case Operator
Case ">"
For i = 1 To cRow
If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) > CDbl(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
Case "<"
For i = 1 To cRow
If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) < CDbl(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
Case ">=", "=>"
For i = 1 To cRow
If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) >= CDbl(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
Case "<=", "=<"
For i = 1 To cRow
If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) <= CDbl(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
End Select
Else
Select Case Operator
Case ">"
For i = 1 To cRow
If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) > CDate(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
Case "<"
For i = 1 To cRow
If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) < CDate(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
Case ">=", "=>"
For i = 1 To cRow
If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) >= CDate(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
Case "<=", "=<"
For i = 1 To cRow
If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) <= CDate(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
Next
End Select
End If
Else
If ExactMatch = False Then
For i = 1 To cRow
If filterArr(i) Like "*" & Value & "*" Then
vArr(i) = left(vArr(i), Len(vArr(i)) - 2)
vReturn = Split(vArr(i), "|^")
Dict.Add i, vReturn
End If
Next
Else
For i = 1 To cRow
If filterArr(i) Like Value & "|^" Then
vArr(i) = left(vArr(i), Len(vArr(i)) - 2)
vReturn = Split(vArr(i), "|^")
Dict.Add i, vReturn
End If
Next
End If
End If

If Dict.Count > 0 Then
ReDim vResult(1 To Dict.Count, 1 To cCol)
i = 1
For Each dictKey In Dict.Keys
For j = 1 To cCol
vResult(i, j) = Dict(dictKey)(j - 1)
Next
i = i + 1
Next
End If

Filtered_DB = vResult
Else
Filtered_DB = DB
End If

End Function

위 코드에서 아래와 같이 표현했는데 필터가 잘 안됩니다.

If Me.Credit_Payment.Value = True Then '외상이면서 17열에 값이 있는경우
DB = Filtered_DB(DB, "외상", 16)
DB = Filtered_DB(DB, "<>", 17)
End If

If Me.Outstanding.Value = True Then '외상이면서 17열이 공란인 경우
DB = Filtered_DB(DB, "외상", 16)
DB = Filtered_DB(DB, "", 17)
End If

#VBA·매크로 #필터·정렬 #사용자정의함수

댓글 1

수
수메리안 채택된 답변 9월 26일
안녕하세요~
첨부파일이 없어서 테스트를 할 수 없는데, 한번 테스트 해 보세요^^
1. 수정내용 :  "<>" 연산자 지원, 빈 값 처리 로직 추가
'// 기존 함수에는 이 부분이 없었음
If Left(Value, 2) = "<>" Then
    Operator = "<>"
    filterValue = Right(Value, Len(Value) - 2)


'// 기존: 단순 문자열 비교만
If filterArr(i) Like "*" & Value & "*" Then

'// 수정 : 빈 값 특별 처리 추가
If filterValue = "" Then
    cellValue = Left(filterArr(i), Len(filterArr(i)) - 2)
    If IsEmpty(cellValue) Or cellValue = "" Or IsNull(cellValue) Then
        '// 빈 값으로 인식
    End If

'// 새로 추가된 부분
If Operator = "<>" Then
    For i = 1 To cRow
        cellValue = Left(filterArr(i), Len(filterArr(i)) - 2)
        If filterValue = "" Then
            '// 빈 값이 아닌 모든 것
            If Not (IsEmpty(cellValue) Or cellValue = "" Or IsNull(cellValue)) Then
                '// 결과에 포함
            End If
        Else
            If cellValue <> filterValue Then
                '// 결과에 포함
            End If
        End If
    Next

2. 전체 코딩
Function Filtered_DB(DB, Value, Optional FilterCol, Optional ExactMatch As Boolean = False) As Variant

Dim cRow As Long
Dim cCol As Long
Dim vArr As Variant: Dim s As String: Dim filterArr As Variant: Dim Cols As Variant: Dim Col As Variant: Dim Colcnt As Long
Dim isDateVal As Boolean
Dim vReturn As Variant: Dim vResult As Variant
Dim Dict As Object: Dim dictKey As Variant
Dim i As Long: Dim j As Long
Dim Operator As String
Dim filterValue As String
Dim cellValue As String

Set Dict = CreateObject("Scripting.Dictionary")

If Value <> "" Or Value = "" Then ' 빈 값도 처리하도록 수정
    cRow = UBound(DB, 1)
    cCol = UBound(DB, 2)
    ReDim vArr(1 To cRow)
    For i = 1 To cRow
        s = ""
        For j = 1 To cCol
            s = s & DB(i, j) & "|^"
        Next
        vArr(i) = s
    Next

    If IsMissing(FilterCol) Then
        filterArr = vArr
    Else
        Cols = Split(FilterCol, ",")
        ReDim filterArr(1 To cRow)
        For i = 1 To cRow
            s = ""
            For Each Col In Cols
                s = s & DB(i, Trim(Col)) & "|^"
            Next
            filterArr(i) = s
        Next
    End If

    '// 수정 :  <> 연산자 처리 추가
    If Left(Value, 2) = "<>" Then
        Operator = "<>"
        filterValue = Right(Value, Len(Value) - 2)
    ElseIf Left(Value, 2) = ">=" Or Left(Value, 2) = "<=" Or Left(Value, 2) = "=>" Or Left(Value, 2) = "=<" Then
        Operator = Left(Value, 2)
        filterValue = Right(Value, Len(Value) - 2)
        If IsDate(filterValue) Then isDateVal = True
    ElseIf Left(Value, 1) = ">" Or Left(Value, 1) = "<" Then
        Operator = Left(Value, 1)
        filterValue = Right(Value, Len(Value) - 1)
        If IsDate(filterValue) Then isDateVal = True
    Else
        filterValue = Value
    End If

    If Operator <> "" Then
        If Operator = "<>" Then
            '// 수정 :  <> 연산자 처리
            For i = 1 To cRow
                cellValue = Left(filterArr(i), Len(filterArr(i)) - 2)
                '// 빈 값 처리 
                If filterValue = "" Then
                    If Not (IsEmpty(cellValue) Or cellValue = "" Or IsNull(cellValue)) Then
                        vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                        vReturn = Split(vArr(i), "|^")
                        Dict.Add i, vReturn
                    End If
                Else
                    If cellValue <> filterValue Then
                        vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                        vReturn = Split(vArr(i), "|^")
                        Dict.Add i, vReturn
                    End If
                End If
            Next
        ElseIf isDateVal = False Then
            Select Case Operator
                Case ">"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) > CDbl(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
                Case "<"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) < CDbl(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
                Case ">=", "=>"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) >= CDbl(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
                Case "<=", "=<"
                    For i = 1 To cRow
                        If CDbl(Left(filterArr(i), Len(filterArr(i)) - 2)) <= CDbl(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
            End Select
        Else
            ' 날짜 처리
            Select Case Operator
                Case ">"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) > CDate(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
                Case "<"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) < CDate(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
                Case ">=", "=>"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) >= CDate(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
                Case "<=", "=<"
                    For i = 1 To cRow
                        If CDate(Left(filterArr(i), Len(filterArr(i)) - 2)) <= CDate(filterValue) Then
                            vArr(i) = Left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                        End If
                    Next
            End Select
        End If
    Else
        ' 일반 텍스트 매칭
        If filterValue = "" Then
            ' 빈 값 검색
            For i = 1 To cRow
                cellValue = Left(filterArr(i), Len(filterArr(i)) - 2)
                If IsEmpty(cellValue) Or cellValue = "" Or IsNull(cellValue) Then
                    vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                    vReturn = Split(vArr(i), "|^")
                    Dict.Add i, vReturn
                End If
            Next
        Else
            If ExactMatch = False Then
                For i = 1 To cRow
                    If filterArr(i) Like "*" & filterValue & "*" Then
                        vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                        vReturn = Split(vArr(i), "|^")
                        Dict.Add i, vReturn
                    End If
                Next
            Else
                For i = 1 To cRow
                    If filterArr(i) Like filterValue & "|^" Then
                        vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                        vReturn = Split(vArr(i), "|^")
                        Dict.Add i, vReturn
                    End If
                Next
            End If
        End If
    End If

    If Dict.Count > 0 Then
        ReDim vResult(1 To Dict.Count, 1 To cCol)
        i = 1
        For Each dictKey In Dict.Keys
            For j = 1 To cCol
                vResult(i, j) = Dict(dictKey)(j - 1)
            Next
            i = i + 1
        Next
        Filtered_DB = vResult
    Else
        ' 결과가 없을 때 빈 배열 반환
        ReDim vResult(1 To 1, 1 To cCol)
        For j = 1 To cCol
            vResult(1, j) = ""
        Next
        Filtered_DB = vResult
    End If
Else
    Filtered_DB = DB
End If

End Function

3. 가능하시면 파일 첨부해서, 테스트를 통해 Debug.Print 내용을 볼 수 있습니다~

질문답변 게시판의 최근 글

스크랩 완료