실시간 경락 정보 #5 데이터 표 만들기

불러온 실시간 경락 정보 데이터를 표로 표시해주는 코드를 추가했습니다.

Option Explicit

'B2셀을 기준으로 CurrentRegion범위를 표1로 변경
Sub MakeTable()
    
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("B2").CurrentRegion, , xlYes).Name = "표1"

End Sub

'ListObject(표)의 서식을 지우고 범위로 변경
Sub ClearTable()

    Dim Otable As ListObject
   '// 기존 표를 "범위로 변환"
    For Each Otable In ActiveSheet.ListObjects
        Otable.TableStyle = ""
        Otable.Unlist
    Next
    
End Sub

 

데이터를 불러올때 표를 지우고 표1로 만들어주기 위해 기존 코드에 추가를 해주었습니다.

Option Explicit

Sub SearchProduct()
    
    Call ClearList
    
    With Sheets("main")
        Call CallOpenAPI(.TextDate.Value, .ComboInstt.Value, .TextSearch.Value)
    End With

End Sub

Sub ClearList()

    Call ClearTable
    
    '제목줄 제외 삭제
    If Range("B3") <> "" Then
        Range("B3", Cells(Rows.Count, "K")).ClearContents '기존 데이터 삭제
    End If
    Range("A2").ClearContents

End Sub

Sub ShowCalender()
    
    FormCalendar.Show

End Sub

Sub CallOpenAPI(mydate As String, instt As String, pn As String)

    Dim strURL As String
    Dim strResult As String
    Dim objHttp As New XMLHTTP60
    Dim apiKey$, sNumber$, eNumber$, searchName$, searchDate$, coName$, productName$
    
    '한글 url 인코딩
    Static objHtmlfile As Object
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        With objHtmlfile.parentWindow
        .execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
        End With
    End If

    apiKey = 인증키
    sNumber = "1"
    eNumber = "500"
    searchName = "부산반여도매"
    searchDate = Replace(mydate, "-", "")   '날짜의 -(하이픈)을 제거
    coName = instt
    productName = pn
    strURL = "http://211.237.50.150:7080/openapi/" & apiKey & "/xml/Grid_20180118000000000580_1/" & sNumber & "/" & eNumber
    strURL = strURL + "?DELNG_DE=" & searchDate
    strURL = strURL + "&PBLMNG_WHSAL_MRKT_NM=" & objHtmlfile.parentWindow.encode(searchName)
    strURL = strURL + "&PRDLST_NM=" & objHtmlfile.parentWindow.encode(productName)
    If instt <> "법인전체" Then
        strURL = strURL + "&CPR_NM=" & objHtmlfile.parentWindow.encode(coName)
    End If
    objHttp.Open "GET", strURL, False
    objHttp.Send
    
    If objHttp.Status = 200 Then '성공했을 경우
        strResult = objHttp.ResponseText
        
        'XML로 연결
        Dim objXml As MSXML2.DOMDocument60
        Set objXml = New DOMDocument60
        objXml.LoadXML (strResult)
        
        '노드 연결
        Dim nodeList As IXMLDOMNodeList
        Dim nodeRow As IXMLDOMNode
        Dim nodeCell As IXMLDOMNode
        Dim nRowCount As Integer
        Dim nCellCount As Integer
        Dim xItem() As String
        Dim aDate$, aTime$
        
'        Set nodeList = objXml.SelectNodes("/Grid_20180118000000000580_1/totalCnt")
'        Range("A2") = nodeList.Item(0).nodeTypedValue
        
        Set nodeList = objXml.SelectNodes("/Grid_20180118000000000580_1/row")

        Application.ScreenUpdating = False        '화면 업데이트 (일시)정지
        
        nRowCount = 2
        For Each nodeRow In nodeList
            nRowCount = nRowCount + 1
            
            nCellCount = 0
            ReDim xItem(1 To nodeRow.ChildNodes.Length)
            For Each nodeCell In nodeRow.ChildNodes
                nCellCount = nCellCount + 1
                xItem(nCellCount) = nodeCell.Text
            Next nodeCell
            
            aDate = Left(xItem(8), 4) & "-" & Mid(xItem(8), 5, 2) & "-" & Mid(xItem(8), 7, 2)
            aTime = Mid(xItem(8), 9, 2) & ":" & Mid(xItem(8), 11, 2)
            
            '경매시간
            Cells(nRowCount, 2).Value = aDate & " " & aTime
            '경매구분
            Cells(nRowCount, 3).Value = xItem(9)
            '도매시장
            Cells(nRowCount, 4).Value = xItem(3)
            '도매법인
            Cells(nRowCount, 5).Value = xItem(5)
            '품목(품종)
            Cells(nRowCount, 6).Value = xItem(12) + "(" + xItem(14) + ")"
            '거래단량+규격
            Cells(nRowCount, 7).Value = xItem(19) + xItem(20)
            '등급
            Cells(nRowCount, 8).Value = xItem(22)
            '가격
            Cells(nRowCount, 9).Value = xItem(18)
            '거래량
            Cells(nRowCount, 10).Value = xItem(30)
            '산치
            Cells(nRowCount, 11).Value = xItem(29)
        Next nodeRow
    
        Call MakeTable
        Application.ScreenUpdating = True
    
    Else
        MsgBox "접속에 에러가 발생했습니다"
    End If

End Sub

 

 

원래는 위처럼 나오던 데이터를 표를 적용시켜서 아래와 같이 나오게 변경하였습니다.