query 밤길 찾기

본 게시글은 전 블로그에서 2020년 8월 31일에 작성한 글입니다 https://blog.naver.com/progress0407/222068926986

query야…. 밤길을 찾아줘

당시에는 테이블이 TABLE_B_126 이런 식으로 네이밍이 되어 있었던 도메인을 맡고 있었습니다…

그래서 어떤 테이블을 통해서 (FK) 접근하면

데이터를 잡아 줄 수 있는지를 자동적으로 매핑하여 가져올 수 있는 구조를 구상했었다

그러나.. 구현상 난이도가 높고 해당 도메인의 업무가 슬슬 들어와서 더 이상의 작업은 하지 않았다

'쿼리 밤길 찾기

Public Function numToChar(number As Variant) As String

    Dim num: num = CInt(number) - 1

    '몫, 나머지
    Dim quotient As Integer, remainder As Integer
    If num < 26 Then
        numToChar = Chr(65 + num)
        Exit Function
    ElseIf num >= 26 Then
        'num+1을 해 주어야 52를 입력했을시 B@같은 상황이 발생하지 않아
        quotient = (num) \ 26
        remainder = (num) Mod 26
        numToChar = numToChar(quotient) & Chr(65 + remainder)
    End If

End Function

Public Function getColor(src As Variant, Optional col) As Variant

    Dim colorVal As Variant
    Dim rng As Range

    'Range(numToChar(leftCol + 1) & r & ":" & numToChar(rightCol) & r)
    If TypeName(src) = "Integer" Or TypeName(src) = "Double" Or TypeName(src) = "Long" Then
        Dim row: row = src
        Dim str: str = numToChar(col) & row & ":" & numToChar(col) & row
        Set rng = Range(str)

    ElseIf TypeName(src) = "Range" Then
        Set rng = src

    Else
        getColor = "Wrong Argument"
        Exit Function

    End If


    If rng.Columns.Count <= 1 And rng.Rows.Count <= 1 Then
        colorVal = rng.Interior.Color
        getColor = Hex(colorVal)

    Else
            getColor = CVErr(xlErrValue)
    End If

End Function


Sub getTableDic()
    Dim tableDicList As Object
    Set tableDicList = CreateObject("Scripting.Dictionary")
    Dim title As Variant
    Dim desc As String
    Dim movingRow, movingCol

    Dim flg As Boolean: flg = False
    For r = 1 To 10
        For c = 1 To 5
            If getColor(r, c) = "FFFF" Then
                movingRow = r
                movingCol = c
                flg = True
                Exit For
            End If
        Next c

        If flg = True Then
            Exit For
        End If
    Next r

    flg = False


    Do While (StrComp(Cells(movingRow, movingCol).Value, "") <> 0)
        Do While (StrComp(Cells(movingRow, movingCol).Value, "") <> 0)

            title = Cells(movingRow, movingCol).Value
            desc = Cells(movingRow, movingCol + 1).Value

            Dim tempObj As Object
            Set tempObj = CreateObject("Scripting.Dictionary")

            tempObj.Add "desc", desc

            r = movingRow + 1
            c = movingCol

            Do While (StrComp(Cells(r, c).Value, "") <> 0)
                tempObj.Add Cells(r, c).Value, Cells(r, c + 1).Value
                r = r + 1
            Loop

            tableDicList.Add title, tempObj
            Set tempObj = Nothing

            movingRow = r + 1
        Loop

        '이만큼 떨어져 있다고 가정하자
        movingCol = movingCol + 3
    Loop


    ' [TestPage 만들기]
    Dim Ws As Worksheet
    Set Ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    Ws.Name = "testSwCho"

    ' 밑에 중에 취사 선택할 것
    Ws.Select

    Cells(1, 1).Value = "성우쿤"


    Dim row As Integer: row = 1

    For Each title In tableDicList
        row = row + 1

        titleStr = CStr(title)

        Cells(row, 1).Value = CStr(title)

        Ws.Cells(row, 1).Interior.Color = RGB(245, 245, 245)


    Next


    Set Ws = Nothing


End Sub




© 2020.12. by 따라쟁이

Powered by philz