[VBA] JSONParse 함수

JSON을 배열로 변경하는 JSONPair함수와 JSONtoArray 함수에 이어서,,,

 

변경된 배열에서 이름 경로를 지정하여 값이나 목록을 검색하는 함수입니다.
JSONParser로 이름을 하고 싶으나,,, VBA로 저장은 되지만 Excel에서 사용할 수 없었습니다.ㅠㅠ

 

이전 버전에서 나오던 일부 오류는 수정하였습니다.

 

【 함수 구문 】

= JsonParse(  JSON ,  Path ,  [ Header ] ,  [PAD ] , [ Delimiter ]  )

 

【 함수 인수 】

인수명	옵션	기본값	설    명
JSON	필수	없음	JSON 텍스트, 배열 또는 범위
Path	필수	없음	검색할 이름, 이름 경로인 경우 "/"를 사용해서 연결, 대소문자 구별함 이름 및 이름 경로에 와일드 카드 사용 가능 이름1/이름2/이름3  -> 이름경로 안전 일치 검색 이름1/*/이름3    -> 두번째 이름 상관없이 첫번째와 세번째 이름 완전일치 검색 이름1/*/이름*    -> 첫번째 이름 완전일치 두번째이름 무시 세번째 이름 유사 검색 **/이름3  -> 경로단계에 상관없이 이름 완전일치 검색
Header	선택	True	검색결과가 목록인 경우 제목에 하위 필드명(Path)을 표시할 지 여부
PAD	선택	빈문자열("")	빈 셀에 채울 값
Delimiter	선택	0	Header에 하위필드명 기재시 다단계인 경우 사용할 구분자, 기본값은 "/"

 

 

함수 사용 예

 

 

 

이름이나 이름경로에 따라 일치하는 행번호와 사용할 열번호를 조사한 다음에

해당 이름:값에 대해서 이름을 열 이름으로 변경한 표 목록을 만들어 표시합니다.

값이 공란인 것과 빈문자열("")인 것을 구별하기 위하여 빈문자열은 쌍따옴표 2개를 그대로 표시합니다.

Function JsonParse(JSON, Path$, Optional Header As Boolean = True, Optional PAD$ = vbNullString, Optional Delimiter$ = "/")
'======================================================================================================
' Name        JsonParse
' Version     v3r0      2024-03-28      EGTools(egexcelvba@gmail.com)
' Param       JSON      JSON text, Array or Range
'             Path      검색할 이름, 이름 경로인 경우 "/"를 사용해서 연결
'                       Path의 각 단계에 와일드카드 사용 가능 "*/이름", "이름1/*/이름*"
'                       "**/이름"를 사용한 경우 단계를 무시하고 적용
'                       이름경로 자체에 "/"가 있는 경우 "\/"로 기재해야 함
'             Header    검색결과가 목록인 경우 제목에 하위 필드명(Path)을 표시할 지 여부
'             PAD       배열을 만든 후 빈 셀에 채울 값, 기본값은 빈문자열("")
'             Delimiter Header에 하위필드명 기재시 다단계인 경우 사용할 구분자, 기본값은 "/"
' Descripton  JSON text중 Name:Value 쌍을 검색하여 Path에 해당하는 결과를 출력
'             검색 결과가 정상 목록인 경우 Header에 따라 필드명을 표시
'             검색 결과가 정상 목록의 일부 필드인 Path의 마지막 항목을 Header에 따라 필등명으로 표시
'             검색 결과가 1개 Field인 경우 Value값만 표시
'             Header에 하위 필드가 여러 단계가 있을 경우 각 단계를 Delimiter로 연결하여 표시
'======================================================================================================
 
    Dim vD, vRow, vResult, vPath, vName, vItem, iR&, iC&, iCnt&, iCol&, iRow&, oDict As Object, Key$, Val
     
    If Trim(Path) = "" Then JsonParse = CVErr(xlErrValue): Exit Function
    vD = JSONpair(JSON, Chr(7)) '// 구분자를 (Bell)로 지정하여 작업함에 주의
    If IsError(vD) Then JsonParse = vD: Exit Function
    If Not IsArray(vD) Then JsonParse = CVErr(xlErrValue): Exit Function
    If UBound(vD, 1) = 1 And UBound(vD, 2) = 1 Then JsonParse = CVErr(xlErrNA): Exit Function
    Path = Replace(Replace(Replace(Path, "\/", vbTab), "/", Chr(7)), vbTab, "/")
    vPath = Split(Path, Chr(7))    '// 이름경로를 배열로 변경
    
    '// 각 행을 검색하여 결과를 기재
    ReDim vRow(1 To UBound(vD, 1), 1 To 4)  '열 1에 행번호, 열2에 열번호 기재
    For iR = 1 To UBound(vD, 1) '// 이름경로에 매칭되는 행만 기록
        If vD(iR, 1) Like (Path & "*") Then
            vName = vD(iR, 1)
            If InStr(Path, "**") Then                               '// 경로 무작위 일치 검색
                vName = Mid(vName, InStr(vName, Replace(Path, "**" & Chr(7), "")))
            ElseIf InStr(Path, "*") Then                            '// 경로 일부 와일드 카드 검색
                vName = Split(vD(iR, 1), Chr(7))
                vItem = Split(Path, Chr(7))
                For iC = LBound(vName) To Application.Min(UBound(vName), UBound(vItem))
                    If Not vName(iC) Like vItem(iC) Then Exit For
                Next iC
                Key = ""
                For iC = iC To Application.Min(UBound(vName), UBound(vItem))
                    Key = Key & IIf(Key = "", "", Chr(7)) & vName(iC)
                Next iC
            ElseIf Left(vName & Chr(7), Len(Path) + 1) = Path & Chr(7) Then  '// 완전일치 검색
                vName = Mid(vName, Len(Path) + 2)
            Else
                GoTo NEXT_ROW
            End If
            iCnt = iCnt + 1
            vRow(iCnt, 1) = iR
            If IsArray(vName) Then vName = Join(vName, Delimiter)
            vRow(iCnt, 2) = vName
            vRow(iCnt, 3) = vD(iR, 1)
            vRow(iCnt, 4) = vD(iR, 2)
        ElseIf vD(iR, 1) = vbNullChar Then    '// 목록구분 빈줄은 그대로
            iCnt = iCnt + 1
            vRow(iCnt, 1) = iR
        End If
NEXT_ROW:
    Next iR
    
    If iCnt = 0 Then JsonParse = CVErr(xlErrNA): Exit Function
    vRow = ResizeArray(vRow, iCnt, 4)
    
    '// 검색된 하위 이름은 Dictionary를 이용하여 열번호를 기록하고 재사용
    Set oDict = CreateObject("Scripting.Dictionary")
    ReDim vResult(1 To iCnt + IIf(Header, 1, 0), 1 To 100)
    iRow = 1 + IIf(Header, 1, 0)
    For iR = 1 To iCnt
      Val = vRow(iR, 4)
      Key = vRow(iR, 2)
      If Val <> """""" Then       '// 값 자체가 ""인 경우에는 쌍따옴표 제거 예외시킴
          If Left(Val, 1) = """" Then Val = Mid(Val, 2)
          If Right(Val, 1) = """" Then Val = Left(Val, Len(Val) - 1)
      End If
      
      If IsEmpty(vRow(iR, 3)) Or vRow(iR, 3) = vbNullChar Then  '// 목록구분 빈행은 줄바꿈 처리
          iRow = iRow + 1
          If iRow > UBound(vResult, 1) Then vResult = ResizeArray(vResult, iRow, UBound(vResult, 2))
      Else
          If Val <> vbNullString And Key = vbNullString Then    '// 하위 이름이 없는 것
              Key = "'No_Name'"
          End If
          If Key <> vbNullString Then                           '// 하위 이름이 있는 것
              If oDict.exists(Key) Then
                  vItem = oDict(Key)
                  vItem(1) = Application.Max(vItem(1) + 1, iRow)
                  If vItem(1) > iRow Then iRow = vItem(1) 'iRow + 1
                  If iRow > UBound(vResult, 1) Then vResult = ResizeArray(vResult, iRow, UBound(vResult, 2))
              Else
                  iCol = iCol + 1
                  If iCol > UBound(vResult, 2) Then vResult = ResizeArray(vResult, UBound(vResult, 1), iCol)
                  ReDim vItem(0 To 1): vItem(0) = iCol: vItem(1) = iRow   '1 + IIf(Header, 1, 0)
              End If
              oDict(Key) = vItem
              vResult(vItem(1), vItem(0)) = Val
          End If
      End If
    Next iR
    
    '// 최종 크기로 배열 조정, 목록형 줄바꿈에 의한 끝부분 빈줄 삭제
    If iRow > UBound(vResult, 1) Then iRow = UBound(vResult, 1)
    vItem = Trim(Join(Application.Index(vResult, iRow), ""))
    Do While vItem = ""
    iRow = iRow - 1: If iRow = 0 Then Exit Do
    vItem = Trim(Join(Application.Index(vResult, iRow), ""))
    Loop
    If iRow = 0 Then JsonParse = CVErr(xlErrNA): GoTo EXIT_RUN
    vResult = ResizeArray(vResult, iRow, iCol)
    
    '// 결과 값이 오직 1개인 경우 그 값을 그대로 출력
    If iRow = 1 + IIf(Header, 1, 0) And iCol = 1 Then JsonParse = vResult(1 + IIf(Header, 1, 0), 1): GoTo EXIT_RUN
        
    If Header Then
        If iCol = 1 And oDict.keys()(0) = "'No_Name'" Then
        '// 열이 1개 뿐이고, 이름이 'No_Name'이면 Path의 마지막 항목을 제목으로 출력
            vResult(1, 1) = vPath(UBound(vPath))
        Else
        '// 열이 여러개인 경우 각열마다 열 이름을 정상 출력
            For Each vItem In oDict.keys
                vResult(1, oDict(vItem)(0)) = Replace(vItem, Chr(7), Delimiter)
            Next vItem
        End If
    End If
        
    If PAD <> vbNullChar Then       '// 빈셀 채우기 지정시 적용
      For iR = 1 To UBound(vResult, 1)
        For iC = 1 To UBound(vResult, 2)
            If IsEmpty(vResult(iR, iC)) Then vResult(iR, iC) = PAD
        Next iC
      Next iR
    End If
    
    JsonParse = vResult

EXIT_RUN:
    Set oDict = Nothing

End Function

 

 

샘플 및 소스가 적용된 파일

JsonParser_v3.xlsm

0.18MB