엑셀 시트 데이터 연결 함수 :: Connect_DB 명령문

Function Connect_DB(DB As Variant, ForeignID_Fields As Variant, FromWS As Worksheet, Fields As String, Optional IncludeHeader As Boolean = False)
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
 
'■ Connect_DB 함수
'■ 서로 다른 두 시트를 연결합니다. FromWS의 첫번째 필드는 반드시 고유값(ID)이 입력되어야 합니다.
'■ 사용방법
'Array = Connect_DB(Get_DB(Sheet1),2,Sheet2, "필드1, 필드2, 필드3")
'■ 인수 설명
'_____________DB                : 병합할 원본 DB입니다.
'_____________ForeignID_Fields  : 연결할 시트에서 참조할 외래ID가 입력된 열번호입니다.
'_____________FromWS            : 연결할 시트입니다.
'_____________Fields            : 연결할 시트에서 불러올 필드목록입니다. 쉼표(,)로 구분하여 입력합니다.
'_____________IncludeHeader     : 머릿글 포함여부입니다. 기본값은 False 입니다.
'■ 사용된 보조명령문
'Get_Dict 함수
'###############################################################
 
Dim cRow As Long: Dim cCol As Long
Dim vForeignID_Fields As Variant: Dim vForeignID_Field As Variant
Dim ForeignID As Variant
Dim vFields As Variant: Dim vField As Variant
Dim vID As Variant: Dim vFieldNo As Variant
Dim Dict As Object
Dim vTemp As Variant
Dim i As Long: Dim j As Long
Dim AddCols As Long
 
 
cRow = UBound(DB, 1)
cCol = UBound(DB, 2)
If InStr(1, Fields, ",") > 1 Then
    AddCols = Len(Fields) - Len(Replace(Fields, ",", "")) + 1
    vFields = Split(Fields, ",")
Else
    AddCols = 1
    vFields = Array(Fields)
End If
 
ReDim Preserve DB(1 To cRow, 1 To cCol + AddCols)
 
Set Dict = Get_Dict(FromWS)
For Each vTemp In Dict.keys
    vID = Dict(vTemp)
    Exit For
Next
 
 
ReDim vFieldNo(0 To UBound(vFields))
 
For Each vField In vFields
    For i = 1 To UBound(vID)
        If vID(i) = Trim(vField) Then vFieldNo(j) = i: j = j + 1
    Next
Next
 
If InStr(1, ForeignID_Fields, ",") > 0 Then vForeignID_Fields = Split(ForeignID_Fields, ",") Else vForeignID_Fields = Array(ForeignID_Fields)
 
For Each vForeignID_Field In vForeignID_Fields
    For i = 1 To cRow
        If IncludeHeader = True And i = 1 Then ForeignID = vTemp Else ForeignID = DB(i, Trim(vForeignID_Field))
        If Dict.Exists(ForeignID) Then
            For j = 1 To AddCols
                DB(i, cCol + j) = Dict(ForeignID)(vFieldNo(j - 1))
            Next
        End If
    Next
Next
 
Connect_DB = DB
 
End Function
 
Function Get_Dict(WS As Worksheet) As Object
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
 
'■ Get_Dict 함수
'■ 시트에 입력된 데이터를 Dictionary로 반환합니다. 첫번째 필드는 반드시 고유값이 입력되어야 합니다.
'■ 사용방법
'Dictionary = Get_Dict(시트)
'■ 인수 설명
'_____________WS            : Dictionary로 변환할 시트입니다.
'###############################################################
Dim cRow As Long: Dim cCol As Long
Dim Dict As Object
Dim vArr As Variant
Dim i As Long: Dim j As Long
 
Set Dict = CreateObject("Scripting.Dictionary")
 
With WS
 
    cRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    cCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 
    For i = 1 To cRow
        ReDim vArr(1 To cCol - 1)
        For j = 2 To cCol
            vArr(j - 1) = .Cells(i, j)
        Next
        Dict.Add .Cells(i, 1).Value, vArr
    Next
End With
 
Set Get_Dict = Dict
 
End Function