미해결 M365윈도우10

필터 DB 함수 문제관련 _컴파일오류 도와주세요!

황

황금감자

10월 9일 조회 1,452

재고만들기 8시간을보며 포기했던 DB 함수 공부를 다시 하고 있는데

필터 텍스트 상자에 한 자라도 쓰기만하면

컴파일 오류가 납니다. 이거 왜이런건가요?

제가 적용중인 수식입니다.

Private Sub ListBox1_Click()
Dim vArr As Variant
    vArr = Get_ListItm(Me.ListBox1)
        Me.P_NameID.Value = vArr(0)
        Me.P_Name01.Value = vArr(1)
        Me.P_Name02.Value = vArr(2)
        Me.P_Name03.Value = vArr(3)
        Me.P_Name04.Value = vArr(4)
        Me.P_Name05.Value = vArr(5)
        Me.P_Name06.Value = vArr(6)
        Me.P_Name07.Value = vArr(7)
        Me.P_Name08.Value = vArr(8)
        Me.P_Name09.Value = vArr(9)
        Me.P_Name10.Value = vArr(10)
        Me.P_Name11.Value = vArr(11)
End Sub
Private Sub P_B_Delete_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
P_Delete
End Sub
Private Sub P_B_Modify_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
P_Modify
End Sub
Private Sub P_B_Register_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
P_Register
End Sub
Private Sub P_B_Reset_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
P_Reset
End Sub
Private Sub txtSearch_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim DB As Variant
    DB = Get_DB(ShtProduct)
    DB = Filtered_DB(DB, Me.txtSearch.Value)
    
    Update_List Me.ListBox1, DB, "0;80;90;70;70;70;90;190;190;50;20;30;"
    
End Sub

Private Sub UserForm_Initialize()
Dim DB As Variant
    DB = Get_DB(ShtProduct)
        Update_List Me.ListBox1, DB, "0;80;90;70;70;70;90;190;190;50;20;30;"
End Sub
Sub P_Modify()
Dim DB As Variant
        Update_Record ShtProduct, Me.P_NameID.Value, Me.P_Name01.Value, Me.P_Name02.Value, _
        Me.P_Name03.Value, Me.P_Name04.Value, Me.P_Name05.Value, _
        Me.P_Name06.Value, Me.P_Name07.Value, Me.P_Name08.Value, _
        Me.P_Name09.Value, Me.P_Name10.Value, Me.P_Name11.Value

        DB = Get_DB(ShtProduct)
        Update_List Me.ListBox1, DB, "0;80;90;70;70;70;90;190;190;50;20;30;"
        Select_ListItm Me.ListBox1, Me.P_NameID.Value
        MsgBox "Product information has been corrected.", vbInformation
End Sub
Sub P_Reset()
    Me.P_Name01.Value = ""
    Me.P_Name02.Value = ""
    Me.P_Name03.Value = ""
    Me.P_Name04.Value = ""
    Me.P_Name05.Value = ""
    Me.P_Name06.Value = ""
    Me.P_Name07.Value = ""
    Me.P_Name08.Value = ""
    Me.P_Name09.Value = ""
    Me.P_Name10.Value = ""
    Me.P_Name11.Value = ""
End Sub
Sub P_Register()
Dim DB As Variant
    Insert_Record ShtProduct, Me.P_Name01.Value, Me.P_Name02.Value, _
    Me.P_Name03.Value, Me.P_Name04.Value, Me.P_Name05.Value, _
    Me.P_Name06.Value, Me.P_Name07.Value, Me.P_Name08.Value, _
    Me.P_Name09.Value, Me.P_Name10.Value, Me.P_Name11.Value
    
    DB = Get_DB(ShtProduct)
        Update_List Me.ListBox1, DB, "0;80;90;70;70;70;90;190;190;50;20;30;"
        P_Reset
        MsgBox "New product registration has been completed.", vbInformation
End Sub
Sub P_Delete()
Dim DB As Variant
Dim YN As VbMsgBoxResult
    YN = MsgBox("Are you sure you want to delete your product information? Information once deleted cannot be recovered.", vbYesNo)
    If YN = vbNo Then Exit Sub
    
    Delete_Record ShtProduct, Me.P_NameID.Value
    
    DB = Get_DB(ShtProduct)
        Update_List Me.ListBox1, DB, "0;80;90;70;70;70;90;190;190;50;20;30;"
        P_Reset
        MsgBox "Product information has been deleted.", vbInformation
End Sub

현재 컴파일 오류가 나는 부분입니다.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) = "<" ThenIf 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 ">=", "=>"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 ">"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 ">=", "=>"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모듈에 저장한 필터 DB 함수입니다.

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

#VBA·매크로 #폼·컨트롤 #사용자정의함수

오

오빠두엑셀 10월 9일

안녕하세요.

복/붙하신 코드에 줄바꿈이 잘못되어있어 오류가 발생한 것 같습니다.

기존 코드대신 아래 코드를 복/붙후 다시 사용해보시겠어요?^^

적어드린 답변이 문제해결에 도움이 되셨길 바랍니다. 감사합니다.

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
 
'■ Filtered_DB 함수
'■ 서로 다른 두 시트를 연결합니다. FromWS의 첫번째 필드는 반드시 고유값(ID)이 입력되어야 합니다.
'■ 사용방법
'Array = Filtered_DB(Get_DB(Sheet1),">=200")
'■ 인수 설명
'_____________DB                  : 데이터를 필터링 할 원본 DB 입니다.
'_____________Value             : 필터링 할 조건입니다.
'_____________FilterCol         : [선택인수] 필터링 할 검색 열입니다. 빈칸일 경우 전체 열을 대상으로 필터링합니다.
'_____________ExactMatch   : [선택인수] 정확히 일치 여부입니다. 기본값은 False(=유사일치) 입니다.
'###############################################################
 
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
 
'<-- 21.08.19 수정 : DB 비어있을 시, 오류 대신 비어있는 DB 반환 -->
If IsEmpty(DB) Then Filtered_DB = DB: Exit Function
 
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) = "=<" 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
 
'<-- 21.08.19 수정 : 제외조건(<>)으로 필터링 가능하도록 수정 -->
    If Operator <> "" And Operator <> "<>" And 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
            If Operator = "<>" Then
                Value = Right(Value, Len(Value) - 2)
                For i = 1 To cRow
                     If Not 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
        Else
            If Operator = "<>" Then
            Value = Right(Value, Len(Value) - 2)
                For i = 1 To cRow
                    If Not 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) = 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
    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