메뉴
이 페이지에서
실무 위키›VBA 코드›ParseJSON

ParseJSON

Function

JSON 데이터에서 지정한 필드의 값만 추출해 배열로 반환하는 VBA 사용자 지정 함수입니다.

예제파일 다운로드
ParseJSON 코드 미리보기
구문 = ParseJSON ( JSON데이터, 추출할필드, [1열머리글], [제외할문자열] )
인수구분 형식 설명
JSON데이터 필수 String
파싱할 JSON 데이터입니다.
추출할필드 필수 String
JSON 데이터에서 추출할 필드명입니다.
여러 개일 경우 쉼표(,)로 구분하여 입력합니다.
1열머리글 선택 String
결과값으로 반환될 배열의 첫 번째 열에 추가할 임의의 머리글입니다. 기본값은 NULL 입니다.
제외할문자열 선택 String
파싱된 데이터 중 제거할 불필요한 문자열입니다. 기본값은 NULL 입니다.
예를 들어 <b>, <em>, <strong> 같은 HTML 태그를 지정하며, 여러 개일 경우 쉼표(,)로 구분합니다.

마스터 코드

복사한 코드는 VBA 편집기(Alt + F11) 새 모듈에 붙여넣어 사용하세요
Module1 · ParseJSON
Function ParseJSON(strJSON, strToParse, Optional strID, Optional strToRemove) As Variant
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ParseJSON 함수
'▶ strJSON 데이터에서 선택한 데이터 값만 추출합니다.
'▶ 인수 설명
'_____________strJSON : JSON 데이터입니다.
'_____________strToParse : JSON 추출할 데이터 필드명입니다. 쉼표(,)로 구분하여 입력합니다.
'_____________strID : 추출한 데이터 배열의 열에 추가할 ID 입니다. (선택인수)
'_____________strToRemove : 추출한 데이터에서 제거할 문자열입니다. 쉼표(,)로 구분하여 입력합니다.
'▶ 사용 예제
'Dim v As Variant
'v = ParseJSON(JsonData, "Date, Name, Item")
'###############################################################
'----------------------------------------------------
'변수 설정
'----------------------------------------------------
Dim vaToParse As Variant: Dim vToParse As Variant
Dim vaToRemove As Variant: Dim vToRemove As Variant
Dim lngStart As Long
Dim objItm As Variant: Dim strItm As String: Dim tmpItm As String
Dim itmCnt As Long
Dim i As Long: Dim r As Long: Dim c As Long
Dim dicItm As Object
Dim vaItm As Variant: Dim vaItems As Variant: Dim vaReturn As Variant
Dim iCol As Long: Dim maxCol As Long: Dim j As Long
Set dicItm = CreateObject("Scripting.Dictionary")
'----------------------------------------------------
'JSON 쿼리 분할
'----------------------------------------------------
vaToParse = Split(strToParse, ",")
If Not IsMissing(strToRemove) Then vaToRemove = Split(strToRemove, ",")
lngStart = InStr(1, strJSON, "[")
strJSON = Right(strJSON, Len(strJSON) - lngStart)
'/*----내부 JSON 구문 제거---*/
strJSON = Replace(strJSON, "{\", "|\")
strJSON = Replace(strJSON, "\""}", "\""^")
'------------------------------------
objItm = Split(strJSON, "{")
itmCnt = UBound(objItm)
For i = 1 To itmCnt
strItm = Split(objItm(i), "}")(0)
strItm = Trim(strItm)
'/*-----------각 항목 줄바꿈으로 구분될 경우 줄바꿈 제거----------*/
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "(,\n\s+" & Chr(34) & ")"
regEx.Global = True
strItm = regEx.Replace(strItm, "," & Chr(34))
'-----------------------------------------------------------------------------
If Left(strItm, 1) = """" Then strItm = Right(strItm, Len(strItm) - 1)
If Right(strItm, 1) = """" Then strItm = Left(strItm, Len(strItm) - 1)
iCol = Len(strItm) - Len(Replace(strItm, ":", ""))
If iCol > maxCol Then maxCol = iCol
If Not IsMissing(strID) Then
If strID <> "" Then
ReDim vaItm(0 To iCol)
vaItm(0) = strID: j = 1
Else
ReDim vaItm(0 To iCol - 1)
j = 0
End If
Else
ReDim vaItm(0 To iCol - 1)
j = 0
End If
On Error Resume Next
For Each vToParse In vaToParse
If InStr(strItm, Trim(vToParse) & """:") > 0 Then
strItm = Replace(strItm, "," & vbNewLine & """", ",""")
tmpItm = Split(strItm, Trim(vToParse) & """:")(1)
tmpItm = Split(tmpItm, ",""")(0)
tmpItm = Trim(tmpItm)
If Left(tmpItm, 1) = """" Then tmpItm = Right(tmpItm, Len(tmpItm) - 1)
If Right(tmpItm, 1) = """" Then tmpItm = Left(tmpItm, Len(tmpItm) - 1)
tmpItm = Replace(tmpItm, "< ", "")
If Not IsMissing(strToRemove) Then
For Each vToRemove In vaToRemove
tmpItm = Replace(tmpItm, Trim(vToRemove), "")
Next
End If
vaItm(j) = tmpItm
ElseIf InStr(strItm, Trim(vToParse) & ":") > 0 Then
tmpItm = Split(strItm, Trim(vToParse) & ":")(1)
tmpItm = Split(tmpItm, ",")(0)
tmpItm = Replace(tmpItm, vbTab, "")
tmpItm = Trim(tmpItm)
Do While Right(tmpItm, 1) = vbLf
tmpItm = Left(tmpItm, Len(tmpItm) - 1)
Loop
If Left(tmpItm, 1) = """" Then tmpItm = Right(tmpItm, Len(tmpItm) - 1)
If Right(tmpItm, 1) = """" Then tmpItm = Left(tmpItm, Len(tmpItm) - 1)
tmpItm = Replace(tmpItm, "< ", "")
If Not IsMissing(strToRemove) Then
For Each vToRemove In vaToRemove
tmpItm = Replace(tmpItm, Trim(vToRemove), "")
Next
End If
vaItm(j) = tmpItm
End If
j = j + 1
Next
On Error GoTo 0
dicItm.Add i, Array(vaItm, 1)
Next
'----------------------------------------------------
'Dictionary -> 배열 변환
'----------------------------------------------------
r = dicItm.Count
c = UBound(vaToParse) + 1
If Not IsMissing(strID) Then
If strID <> "" Then c = c + 1
End If
If r = 0 Then ParseJSON = "" : Exit Function
vaItems = dicItm.Items
ReDim vaReturn(1 To r, 1 To c)
On Error Resume Next
For i = 0 To r - 1
For j = 0 To c - 1
tmpItm = vaItems(i)(0)(j)
If IsNumeric(tmpItm) And Left(tmpItm, 1) <> 0 Then vaReturn(i + 1, j + 1) = CDbl(tmpItm) Else vaReturn(i + 1, j + 1) = tmpItm
Next
Next
On Error GoTo 0
'----------------------------------------------------
'결과값 리턴
'----------------------------------------------------
ParseJSON = vaReturn
End Function

활용 예제

JSON 데이터에서 color 필드만 배열로 반환하기
= ParseJSON ( JSON데이터, "color" )
color · value 필드를 반환하면서 "#" 기호 제거하기
= ParseJSON ( JSON데이터, "color,value", , "#" )

안내사항

온전한 형태의 JSON 데이터에서만 동작합니다.
항목 구분기호가 누락된 불완전한 데이터일 경우 아래첨자 관련 컴파일 오류가 발생하거나 옳지 않은 형태로 데이터가 추출될 수 있습니다.
댓글 4
5 (2개 평가)
11월의카프카
11월의카프카 2023.02.13 13:11
안녕하세요.
위 코드 설명 중, 4번 "Dictionary 를 배열로 변환" 에서

If r = 0 Then ParseJSON = ""
r=0 이면 ParseJSON 값으로 "" 돌려주고 해당 함수는 종료되어야 하는거 아닌지 문의드립니다.
r=0 인 상태에서 다음 코드로 넘어가면 Redim 에서 에러가 나더라구요.
오빠두엑셀
오빠두엑셀 작성자 2023.02.14 14:19
앗! 그렇네요!^^
확인해주셔서 감사합니다.
코드는 바로 수정하겠습니다.
11월의카프카
11월의카프카 2023.02.14 17:06
휴..다행이네요. 잘 알지못하면서 딴지 거는건 아닌가 걱정했거든요. ㅎㅎ
저도 도움이 된거같아 기쁩니다. :)
강민준🤗
강민준🤗 2024.08.11 12:46
좋은 자료 감사합니다.🙇‍♂️
스크랩 완료