[재고관리프로그램] 엑셀 재고관리 툴 만들기 - 8시간 풀영상

강의 안내

이번 강의는 엑셀 VBA를 활용하여 실무에서 바로 사용할 수 있는 재고관리 프로그램을 처음부터 끝까지 완성하는 풀스택(DB 관리 → 유저폼 제작) 강의입니다. 다루는 내용이 방대해 모든 단계를 글로 옮기기에는 한계가 있어, 각 섹션에서 사용된 핵심 명령문을 아래에 정리해두었습니다. 강의 진행 중 발견된 수정 사항이나 자주 묻는 질문은 본 게시글에서 주기적으로 업데이트합니다.

본 영상은 지난 5주간 진행된 라이브 강의의 핵심 부분을 8시간 분량으로 요약한 강의입니다. 이번 강의에서 다루지 못한 Q&A 및 상세 내용은 재고관리 프로그램 만들기 라이브 전체 영상을 참고해주세요.

각 섹션별 자주묻는 질문&답변

VBA 편집기는 사용자가 오류를 확인하고 수정하기 편리하도록 구성되어 있습니다. VBA에서 발생하는 오류 종류와 디버깅(오류 수정)에 대한 자세한 설명은 아래 포스트를 참고해주세요.

Q. Get_DB 함수를 사용하면 범위의 맨 마지막값이 반환되지 않습니다. (00:30:42)

Get_DB 함수는 표 머리글의 오른쪽에 최대 ID 셀이 위치한다고 가정하고 동작합니다. 따라서 머리글 오른쪽에 최대 ID가 없는 경우에는 NoID 인수를 TRUE로 지정하여 사용해주세요.

Q. Filtered_DB 명령문을 사용해서 제외조건 (<>) 으로 필터링 할 수 있나요? (05:48:25)

강의에서 사용한 Filtered_DB 함수를 새롭게 업데이트된 Filtered_DB 함수로 교체하시면 제외조건으로 필터링할 수 있습니다.

Q. 당일 재고를 조회하거나 없는 재고일 경우 "'13 런타임 오류', 형식이 일치하지 않습니다." 라는 오류메시지가 출력됩니다. (06:38:58)

강의에서 사용한 Filtered_DB 함수는 비어있는 DB를 인수로 받으면 오류를 출력합니다. Filtered_DB 명령문을 업데이트된 함수로 교체하시거나, 기존 Filtered_DB 함수의 변수 선언부(Dim...) 바로 아래에 다음 코드를 추가하시면 문제가 해결됩니다.

'<-- 21.08.19 수정 : DB 비어있을 시, 오류 대신 비어있는 DB 반환 -->
If IsEmpty(DB) Then Filtered_DB = DB: Exit Function

엑셀 DB 관련 매크로 전체 명령문

홈페이지에서 제공하는 DB 관련 함수를 사용하면, 시트에 입력된 데이터를 파워피벗이나 파워쿼리 등 외부 도구 없이 관계형 DB로 구축하고 빠르게 가공할 수 있습니다. 각 DB 관련 함수의 자세한 사용법은 아래 영상강의를 참고해주세요.

DB 관련 함수 목록

DB 관련 함수 전체 명령문

아래 명령문을 복사한 뒤, 새로운 모듈에 붙여넣기 후  사용합니다.

Option Explicit
Option Compare Text
'########################
' 특정 워크시트에서 앞으로 추가해야 할 최대 ID번호 리턴 (시트 DB 우측 첫번째 머릿글)
' i = Get_MaxID(Sheet1)
'########################
Function Get_MaxID(WS As Worksheet) As Long
With WS
    Get_MaxID = .Cells(1, .Columns.Count).End(xlToLeft).Value
    .Cells(1, .Columns.Count).End(xlToLeft).Value = .Cells(1, .Columns.Count).End(xlToLeft).Value + 1
End With
End Function
'########################
' 워크시트에 새로운 데이터를 추가해야 할 열번호 반환
' i = Get_InsertRow(Sheet1)
'########################
Function Get_InsertRow(WS As Worksheet) As Long
With WS:    Get_InsertRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With
End Function
'########################
' 시트의 열 개수 반환 (이번 예제파일에서만 사용)
' i  = Get_ColumnCnt(Sheet1)
'########################
Function Get_ColumnCnt(WS As Worksheet, Optional Offset As Long = -1) As Long
With WS:    Get_ColumnCnt = .Cells(1, .Columns.Count).End(xlToLeft).Column + Offset: End With
End Function
'########################
' 시트에서 특정 ID 의 행 번호 반환 (-> 해당 행 번호 데이터 업데이트)
' i = get_UpdateRow(Sheet1, ID)
'########################
Function get_UpdateRow(WS As Worksheet, ID)
Dim i As Long
Dim cRow As Long
With WS
    cRow = Get_InsertRow(WS) - 1
    For i = 1 To cRow
        If .Cells(i, 1).Value = ID Then get_UpdateRow = i: Exit For
    Next
End With
End Function

'########################
' 특정 시트의 DB 정보를 배열로 반환 (이번 예제파일에서만 사용)
' Array = Get_DB(Sheet1)
'########################
Function Get_DB(WS As Worksheet, Optional NoID As Boolean = False, Optional IncludeHeader As Boolean = False) As Variant

Dim cRow As Long
Dim cCol As Long
Dim offCol As Long

If NoID = False Then offCol = -1

With WS
    cRow = Get_InsertRow(WS) - 1
    cCol = Get_ColumnCnt(WS, offCol)
    Get_DB = .Range(.Cells(2 + Sgn(IncludeHeader), 1), .Cells(cRow, cCol))
End With
    
End Function
'########################
'특정 시트에서 지정한 ID의 필드 값 반환 (이번 예제파일 전용)
' Value = Get_Records(Sheet1, ID, "필드명")
'########################
Function Get_Records(WS As Worksheet, ID, Fields)

Dim cRow As Long: Dim cCol As Long
Dim vFields As Variant: Dim vField As Variant
Dim vFieldNo As Variant
Dim i As Long: Dim j As Long

cRow = Get_InsertRow(WS) - 1
cCol = Get_ColumnCnt(WS)

If InStr(1, Fields, ",") > 0 Then vFields = Split(Fields, ",") Else vFields = Array(Fields)
ReDim vFieldNo(0 To UBound(vFields))

With WS
    For Each vField In vFields
        For i = 1 To cCol
            If .Cells(1, i).Value = Trim(vField) Then vFieldNo(j) = i: j = j + 1
        Next
    Next

    For i = 2 To cRow
        If .Cells(i, 1).Value = ID Then
            For j = 0 To UBound(vFieldNo)
                vFieldNo(j) = .Cells(i, vFieldNo(j))
            Next
            Exit For
        End If
    Next
    
Get_Records = vFieldNo

End With

End Function

'########################
' 시트에 새로운 레코드 추가 (반드시 첫번째 값은 ID, 나머지 값 순서대로 입력)
' Insert_Record Sheet1, ID, 필드1, 필드2, 필드3, ..
'########################
Sub Insert_Record(WS As Worksheet, ParamArray vaParamArr() As Variant)

Dim cID As Long
Dim cRow As Long
Dim vaArr As Variant: Dim i As Long: i = 2

With WS
    cRow = Get_InsertRow(WS)
    If InStr(1, .Cells(1, 1).Value, "ID") > 0 Then
        cID = Get_MaxID(WS)
        .Cells(cRow, 1).Value = cID
        For Each vaArr In vaParamArr
            .Cells(cRow, i).Value = vaArr
            i = i + 1
        Next
    Else
        For Each vaArr In vaParamArr
            .Cells(cRow, i - 1).Value = vaArr
            i = i + 1
        Next
    End If
    
End With

End Sub
'########################
' 시트에서 ID 를 갖는 레코드의 모든 값 업데이트 (반드시 첫번째 값은 ID여야 하며, 나머지 값을 순서대로 입력)
' Update_Record Sheet1, ID, 필드1, 필드2, 필드3, ...
'########################
Sub Update_Record(WS As Worksheet, ParamArray vaParamArr() As Variant)

Dim cRow As Long
Dim i As Long
Dim ID As Variant

If IsNumeric(vaParamArr(0)) = True Then ID = CLng(vaParamArr(0)) Else ID = vaParamArr(0)

With WS
    cRow = get_UpdateRow(WS, ID)
    
    For i = 1 To UBound(vaParamArr)
        If Not IsMissing(vaParamArr(i)) Then .Cells(cRow, i + 1).Value = vaParamArr(i)
    Next
    
End With

End Sub
'########################
' 시트에서 ID 를 갖는 레코드 삭제
' Delete_Record Sheet1, ID
'########################
Sub Delete_Record(WS As Worksheet, ID)

Dim cRow As Long

If IsNumeric(ID) = True Then ID = CLng(ID)

With WS
    cRow = get_UpdateRow(WS, ID)
    .Cells(cRow, 1).EntireRow.Delete
End With

End Sub

'########################
' 배열의 외부ID키 필드를 본 시트DB와 연결하여 해당 외부ID키의 연관된 값을 배열로 반환
' Array = Connect_DB(Get_DB(Sheet1),2,Sheet2, "필드1, 필드2, 필드3")
'########################
Function Connect_DB(DB As Variant, ForeignID_Fields As Variant, FromWS As Worksheet, Fields As String, Optional IncludeHeader As Boolean = False)

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 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)
vID = Dict("ID")

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 = "ID" 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
'########################
' 특정 배열에서 Value를 포함하는 레코드만 찾아 다시 배열로 반환
' Array = Filtered_DB(Array, "검색값", False)
'########################
Function Filtered_DB(DB, Value, Optional FilterCol, Optional ExactMatch As Boolean = False) As Variant

Dim cRow As Long
Dim cCol As Long
Dim vArr As Variant: Dim s As String: Dim filterArr As Variant:  Dim Cols As Variant: Dim Col As Variant: Dim Colcnt As Long
Dim isDateVal As Boolean
Dim vReturn As Variant: Dim vResult As Variant
Dim Dict As Object: Dim dictKey As Variant
Dim i As Long: Dim j As Long
Dim Operator As String

Set Dict = CreateObject("Scripting.Dictionary")

If Value <> "" Then
    cRow = UBound(DB, 1)
    cCol = UBound(DB, 2)
    ReDim vArr(1 To cRow)
    For i = 1 To cRow
        s = ""
        For j = 1 To cCol
            s = s & DB(i, j) & "|^"
        Next
        vArr(i) = s
    Next
    
    If IsMissing(FilterCol) Then
        filterArr = vArr
    Else
        Cols = Split(FilterCol, ",")
        ReDim filterArr(1 To cRow)
        For i = 1 To cRow
            s = ""
            For Each Col In Cols
                s = s & DB(i, Trim(Col)) & "|^"
            Next
            filterArr(i) = s
        Next
    End If
    
    If left(Value, 2) = ">=" Or left(Value, 2) = "<=" Or left(Value, 2) = "=>" Or left(Value, 2) = "=<" Then Operator = left(Value, 2) If IsDate(Right(Value, Len(Value) - 2)) Then isDateVal = True ElseIf left(Value, 1) = ">" Or left(Value, 1) = "<" Then
        Operator = left(Value, 1)
        If IsDate(Right(Value, Len(Value) - 1)) Then isDateVal = True
    Else: End If
    
    If Operator <> "" Then
        If isDateVal = False Then
            Select Case Operator
                Case ">"
                    For i = 1 To cRow
                        If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) > CDbl(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                Case "<"
                    For i = 1 To cRow
                        If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) < CDbl(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn Next Case ">=", "=>"
                    For i = 1 To cRow
                        If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) >= CDbl(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                 Case "<=", "=<"
                    For i = 1 To cRow
                        If CDbl(left(filterArr(i), Len(filterArr(i)) - 2)) <= CDbl(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn Next End Select Else Select Case Operator Case ">"
                    For i = 1 To cRow
                        If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) > CDate(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                Case "<"
                    For i = 1 To cRow
                        If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) < CDate(Right(Value, Len(Value) - 1)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn Next Case ">=", "=>"
                    For i = 1 To cRow
                        If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) >= CDate(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn
                    Next
                 Case "<=", "=<"
                    For i = 1 To cRow
                        If CDate(left(filterArr(i), Len(filterArr(i)) - 2)) <= CDate(Right(Value, Len(Value) - 2)) Then: vArr(i) = left(vArr(i), Len(vArr(i)) - 2): vReturn = Split(vArr(i), "|^"): Dict.Add i, vReturn Next End Select End If Else If ExactMatch = False Then For i = 1 To cRow If filterArr(i) Like "*" & Value & "*" Then vArr(i) = left(vArr(i), Len(vArr(i)) - 2) vReturn = Split(vArr(i), "|^") Dict.Add i, vReturn End If Next Else For i = 1 To cRow If filterArr(i) Like Value & "|^" Then vArr(i) = left(vArr(i), Len(vArr(i)) - 2) vReturn = Split(vArr(i), "|^") Dict.Add i, vReturn End If Next End If End If If Dict.Count > 0 Then
        ReDim vResult(1 To Dict.Count, 1 To cCol)
        i = 1
        For Each dictKey In Dict.Keys
            For j = 1 To cCol
                vResult(i, j) = Dict(dictKey)(j - 1)
            Next
            i = i + 1
        Next
    End If
    
    Filtered_DB = vResult
Else
    Filtered_DB = DB
End If

End Function

'########################
' 각 제품별 잔고수량을 계산합니다.
' DB = Get_Balance(DB, shtInventory, 입고수량열번호, 출고수량열번호, 제품ID열번호)
'########################

Function Get_Balance(DB, InventoryWS As Worksheet, ColumnIN, ColumnOUT, ColumnID) As Variant

Dim InventoryDB As Variant
Dim Dict As Dictionary
Dim cRow As Long: Dim cCol As Long
Dim i As Long: Dim cID

If Not IsNumeric(ColumnOUT) Then ColumnOUT = Range(ColumnOUT & 1).Column
If Not IsNumeric(ColumnIN) Then ColumnIN = Range(ColumnIN & 1).Column
If Not IsNumeric(ColumnID) Then ColumnID = Range(ColumnID & 1).Column

cRow = UBound(DB, 1)
cCol = UBound(DB, 2)
Set Dict = CreateObject("Scripting.Dictionary")

ReDim Preserve DB(1 To cRow, 1 To cCol + 1)

For i = 1 To cRow:    Dict.Add DB(i, 1), 0: Next
InventoryDB = Get_DB(InventoryWS)

For i = LBound(InventoryDB, 1) To UBound(InventoryDB, 1)
    cID = InventoryDB(i, ColumnID)
    If Dict.Exists(cID) Then
        Dict(cID) = Dict(cID) + InventoryDB(i, CLng(ColumnIN)) - InventoryDB(i, CLng(ColumnOUT))
    End If
Next

For i = LBound(DB, 1) To UBound(DB, 1)
    DB(i, cCol + 1) = Dict(DB(i, 1))
Next

Get_Balance = DB

End Function

'########################
' 특정 시트의 DB 정보를 Dictionary로 반환 (이번 예제파일에서만 사용)
' Dict = GetDict(Sheet1)
'########################
Function Get_Dict(WS As Worksheet) As Object

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 = Get_InsertRow(WS) - 1
    cCol = Get_ColumnCnt(WS)
    
    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

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ Arr_To_Dict 함수
'▶ 범위를 Dictionary 로 변환합니다.
'▶ 인수 설명
'_____________Arr       : Dictionary로 변환할 배열입니다.
'▶ 사용 예제
'Dict = Arr_To_Dict(Arr)
'##############################################################
Function Arr_To_Dict(Arr As Variant) As Object

Dim Dict As Object: Dim vArr As Variant
Dim cCol As Long
Dim i As Long: Dim j As Long

Set Dict = CreateObject("Scripting.Dictionary")
cCol = UBound(Arr, 2)

For i = LBound(Arr, 1) To UBound(Arr, 1)
        ReDim vArr(1 To cCol - 1)
        For j = 2 To cCol
            vArr(j - 1) = Arr(i, j)
        Next
        Dict.Add Arr(i, 1), vArr
Next

Set Arr_To_Dict = Dict

End Function

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ Dict_To_Arr 함수
'▶ Dictionary를 범위로 변환합니다.
'▶ 인수 설명
'_____________Dict       : 배열로 변환할 Dictionary 입니다.
'▶ 사용 예제
'Arr = Dict_To_Arr(Dict)
'##############################################################
Function Dict_To_Arr(Dict As Object) As Variant

Dim i As Long: Dim j As Long: Dim dictKey As Variant: Dim cCol As Long
Dim vTest As Variant
i = 1

If Dict.Count > 0 Then
    If IsObject(Dict(Dict.Keys()(0))) Then cCol = UBound(Dict(Dict.Keys()(0))) Else cCol = 1
    ReDim vResult(1 To Dict.Count, 1 To cCol + 1)
    For Each dictKey In Dict.Keys
        vResult(i, 1) = dictKey
        If cCol = 1 Then
            vResult(i, 2) = Dict(dictKey)
        Else
            For j = 2 To cCol + 1
                vResult(i, j) = Dict(dictKey)(j - 1)
            Next
        End If
        i = i + 1
    Next
End If

Dict_To_Arr = vResult
    
End Function
'########################
' 시트의 특정 필드 내에서 추가되는 값이 고유값인지 확인. 고유값일 경우 TRUE를 반환
' boolean = IsUnique(Sheet1, "사과", 1)
'########################
Function IsUnique(DB As Variant, uniqueVal, Optional ColNo As Long = 1, Optional Exclude) As Boolean

Dim endRow As Long
Dim i As Long

For i = LBound(DB, 1) To UBound(DB, 1)
    If DB(i, ColNo) = uniqueVal Then
        If Not IsMissing(Exclude) Then
            If Exclude <> uniqueVal Then
                IsUnique = False
                Exit Function
            End If
        Else
            IsUnique = False: Exit Function
        End If
    End If
Next

IsUnique = True

End Function

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ Extract_Column 함수
'▶ 배열에서 지정한 열을 추출합니다.
'▶ 인수 설명
'_____________DB        : 특정 열을 추출할 배열입니다.
'_____________Col       : 배열에서 추출할 열의 열번호입니다.
'▶ 사용 예제
'Arr = Extract_Column(Arr, 3) '<- 3번째 열을 추출합니다.
'##############################################################

Function Extract_Column(DB As Variant, Col As Long) As Variant

Dim i As Long
Dim vArr As Variant

ReDim vArr(LBound(DB) To UBound(DB), 1 To 1)
For i = LBound(DB) To UBound(DB)
        vArr(i, 1) = DB(i, Col)
Next

Extract_Column = vArr

End Function

윈도우10 스타일 유저폼 관련 명령문

윈도우 10 스타일 유저폼 명령문을 사용하면 엑셀 VBA의 기본 유저폼 디자인을 업그레이드하여 윈도우 10 스타일의 모던 유저폼으로 만들 수 있습니다. 자세한 설명과 사용법은 아래 영상강의를 참고해주세요.

윈도우 10 스타일 유저폼 만들기 전체 명령문

아래 명령문을 해당 유저폼 모듈에 붙여넣기 후 사용합니다.

'유저폼에 추가한 버튼에 개수만큼 아래 명령문을 유저폼에 추가한 뒤, btnXXX를 버튼 이름으로 변경합니다.
Private Sub btnXXX_Exit(ByVal Cancel As MSForms.ReturnBoolean)
OutHover_Css Me.btnXXX
End Sub

Private Sub btnXXX_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
OnHover_Css Me.btnXXX
End Sub

Private Sub btnXXX_Enter()
OnHover_Css Me.btnXXX
End Sub

'아래 코드를 유저폼에 추가한 뒤, "btnXXX, btnYYY"를 버튼이름을 쉼표로 구분한 값으로 변경합니다.
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim ctl As Control
Dim btnList As String: btnList = "btnXXX, btnYYY" ' 버튼 이름을 쉼표로 구분하여 입력하세요.
Dim vLists As Variant: Dim vList As Variant
If InStr(1, btnList, ",") > 0 Then vLists = Split(btnList, ",") Else vLists = Array(btnList)
For Each ctl In Me.Controls
    For Each vList In vLists
        If InStr(1, ctl.Name, Trim(vList)) > 0 Then OutHover_Css ctl
    Next
Next
End Sub

'커서 이동시 버튼 색깔을 변경하는 보조명령문을 유저폼에 추가합니다.
Private Sub OnHover_Css(lbl As Control): With lbl:   .BackColor = RGB(211, 240, 224):    .BorderColor = RGB(134, 191, 160): End With: End Sub
Private Sub OutHover_Css(lbl As Control): With lbl:   .BackColor = &H8000000E:    .BorderColor = &H8000000A: End With: End Sub

배열/범위 핸들링 관련 명령문

배열과 범위를 다루는 명령문을 사용하면 2차원 배열의 정렬, 시트로 출력, 순번 자동 입력 등 다양한 작업을 간결하게 처리할 수 있습니다.

배열/범위 핸들링 함수 목록

배열/범위 핸들링 함수 전체 명령문

아래 명령문을 새로운 모듈에 붙여넣기 후 사용합니다.

Option Explicit

Function Sort2DArray(DB, ByVal Index As Long, Optional ByVal Order As Integer = -1, Optional ByVal ByColumn As Boolean = False, Optional ByVal lngStart As Long = 0, Optional ByVal lngEnd As Long = 0, Optional THRESHOLD As Long = 20)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
'
'■ Sort2DArray 명령문
'■ 2차원 배열을 오름차순/내림차순 또는 내림차순으로 정렬합니다. 한계점을 설정하여 QuickSort 또는 InsertionSort로 보다 빠르게 정렬할 수 있습니다. 기본 한계점은 20입니다.
'■ 인수 설명
'_____________DB                : 정렬할 배열입니다.
'_____________Index            : DB를 정렬할 기준 순번입니다.
'_____________Order           : [선택인수] 1 이면 내림차순 정렬합니다. 기본값은 -1 (=오름차순) 정렬입니다.
'_____________ByColumn    : [선택인수] True 면 열방향(가로방향) 정렬입니다. 기본값은 FALSE 입니다.
'_____________lngStart        : [선택인수] 정렬을 시작할 시작점입니다. 기본값은 배열의 시작지점입니다.
'_____________lngEnd         : [선택인수] 정렬을 종료할 마지막점입니다. 기본값은 배열의 마지막지점입니다.
'_____________Threshold    : [선택인수] QuickSort와 InsertionSort를 구분할 한계점입니다. 기본값은 20 입니다. Threshold 는 사용되는 데이터의 구성에 따라 다르지만 대부분 10-20 사이의 정수가 사용됩니다.
'■ 반환값
'_____________정렬된 배열을 반환합니다.
'본 명령문은 아래 링크를 참조하여 작성된 명령문입니다.
'https://www.vbforums.com/showthread.php?631366-RESOLVED-Quick-Sort-2D-Array
'###############################################################

Dim i As Long: Dim j As Long: Dim k As Long
Dim Pivot: Dim Temp
Dim Stack(1 To 64) As Long: Dim StackPtr As Long

If lngStart = 0 Then
    If ByColumn = False Then lngStart = LBound(DB, 1) Else lngStart = LBound(DB, 2)
End If

If lngEnd = 0 Then
    If ByColumn = False Then lngEnd = UBound(DB, 1) Else lngEnd = UBound(DB, 2)
End If

'가로방향 정렬
  If ByColumn Then
    ReDim Temp(LBound(DB, 1) To UBound(DB, 1))
    Stack(StackPtr + 1) = lngStart
    Stack(StackPtr + 2) = lngEnd
    StackPtr = StackPtr + 2
    Do
      StackPtr = StackPtr - 2
      lngStart = Stack(StackPtr + 1)
      lngEnd = Stack(StackPtr + 2)
      If lngEnd - lngStart < THRESHOLD Then ' 비교 대상의 첫번째 값과 마지막값 차이가 20 미만일 경우 Insertion Sort For j = lngStart + 1 To lngEnd For k = LBound(DB, 1) To UBound(DB, 1) Temp(k) = DB(k, j) Next Pivot = DB(Index, j) For i = j - 1 To lngStart Step -1 If Order >= 0 Then
              If DB(Index, i) <= Pivot Then Exit For Else If DB(Index, i) >= Pivot Then Exit For
            End If
            For k = LBound(DB) To UBound(DB)
              DB(k, i + 1) = DB(k, i)
            Next
          Next
          For k = LBound(DB) To UBound(DB)
            DB(k, i + 1) = Temp(k)
          Next
        Next
      Else
        ' 비교 대상의 첫번째 값과 마지막값 차이가 20 이상일 경우 Quick Sort
        i = lngStart: j = lngEnd
        Pivot = DB(Index, (lngStart + lngEnd) \ 2)
        Do
          If Order >= 0 Then
            Do While (DB(Index, i) < Pivot): i = i + 1: Loop Do While (DB(Index, j) > Pivot): j = j - 1: Loop
          Else
            Do While (DB(Index, i) > Pivot): i = i + 1: Loop
            Do While (DB(Index, j) < Pivot): j = j - 1: Loop
          End If
          If i <= j Then
            If i < j Then For k = LBound(DB) To UBound(DB) Temp(k) = DB(k, i) DB(k, i) = DB(k, j) DB(k, j) = Temp(k) Next End If i = i + 1: j = j - 1 End If Loop Until i > j
        If (lngStart < j) Then
          Stack(StackPtr + 1) = lngStart
          Stack(StackPtr + 2) = j
          StackPtr = StackPtr + 2
        End If
        If (i < lngEnd) Then
          Stack(StackPtr + 1) = i
          Stack(StackPtr + 2) = lngEnd
          StackPtr = StackPtr + 2
        End If
      End If
    Loop Until StackPtr = 0
'세로방향 정렬
Else
    ReDim Temp(LBound(DB, 2) To UBound(DB, 2))
        ' Stack 설정
        Stack(StackPtr + 1) = lngStart
        Stack(StackPtr + 2) = lngEnd
        StackPtr = StackPtr + 2
            Do
                StackPtr = StackPtr - 2
                lngStart = Stack(StackPtr + 1)
                lngEnd = Stack(StackPtr + 2)
                    ' 비교 대상의 첫번째 값과 마지막값 차이가 20 미만일 경우 Insertion Sort
                    If lngEnd - lngStart < THRESHOLD Then For j = lngStart + 1 To lngEnd For k = LBound(DB, 2) To UBound(DB, 2) Temp(k) = DB(j, k) Next Pivot = DB(j, Index) For i = j - 1 To lngStart Step -1 If Order >= 0 Then
                                If DB(i, Index) <= Pivot Then Exit For Else If DB(i, Index) >= Pivot Then Exit For
                              End If
                              For k = LBound(DB, 2) To UBound(DB, 2)
                                DB(i + 1, k) = DB(i, k)
                              Next
                            Next
                            For k = LBound(DB, 2) To UBound(DB, 2)
                              DB(i + 1, k) = Temp(k)
                            Next
                          Next
                Else
                    ' 비교 대상의 첫번째 값과 마지막값 차이가 20 이상일 경우 Quick Sort
                    i = lngStart: j = lngEnd
                    Pivot = DB((lngStart + lngEnd) \ 2, Index)
                        Do
                            If Order >= 0 Then
                                Do While (DB(i, Index) < Pivot): i = i + 1: Loop Do While (DB(j, Index) > Pivot): j = j - 1: Loop
                            Else
                                Do While (DB(i, Index) > Pivot): i = i + 1: Loop
                                Do While (DB(j, Index) < Pivot): j = j - 1: Loop
                            End If
                            If i <= j Then
                                  If i < j Then For k = LBound(DB, 2) To UBound(DB, 2) Temp(k) = DB(i, k) DB(i, k) = DB(j, k) DB(j, k) = Temp(k) Next End If i = i + 1: j = j - 1 End If Loop Until i > j
                            If (lngStart < j) Then
                                  Stack(StackPtr + 1) = lngStart
                                  Stack(StackPtr + 2) = j
                                  StackPtr = StackPtr + 2
                            End If
                            If (i < lngEnd) Then
                                  Stack(StackPtr + 1) = i
                                  Stack(StackPtr + 2) = lngEnd
                                  StackPtr = StackPtr + 2
                            End If
                End If
            Loop Until StackPtr = 0
End If
  
Sort2DArray = DB
  
End Function

Sub ArrayToRng(startRng As Range, Arr As Variant, Optional ColumnNo As String = "")

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ArrayToRng 함수
'▶ 배열을 범위 위로 반환합니다.
'▶ 인수 설명
'_____________startRng      : 배열을 반환할 기준 범위(셀) 입니다.
'_____________Arr               : 반환할 배열입니다.
'_____________ColumnNo   : [선택인수] 배열의 특정 열을 선택하여 범위로 반환합니다. 여러개 열을 반환할 경우 열 번호를 쉼표로 구분하여 입력합니다.
'                                               값으로 공란을 입력하면 열을 건너뜁니다.
'▶ 사용 예제
'Dim v As Variant
'ReDim v(0 to 1)
''v(0) = "a" : v(1) = "b"
'ArrayToRng Sheet1.Range("A1"), v
'▶ 사용된 보조 명령문
'Extract_Column 함수
'##############################################################

On Error GoTo SingleDimension:

Dim Cols As Variant: Dim Col As Variant
Dim X As Long: X = 1
If ColumnNo = "" Then
    startRng.Cells(1, 1).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1) = Arr
Else
    Cols = Split(ColumnNo, ",")
    For Each Col In Cols
        If Trim(Col) <> "" Then
            startRng.Cells(1, X).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1) = Extract_Column(Arr, CLng(Trim(Col)))
        End If
        X = X + 1
    Next
End If
Exit Sub

SingleDimension:
Dim tempArr As Variant: Dim i As Long
ReDim tempArr(LBound(Arr, 1) To UBound(Arr, 1), 1 To 1)
For i = LBound(Arr, 1) To UBound(Arr, 1)
    tempArr(i, 1) = Arr(i)
Next
startRng.Cells(1, 1).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, 1) = tempArr

End Sub

Sub SequenceToRng(startRng As Range, Count As Long, Optional StartNo As Double = 1, Optional Increment As Double = 1, Optional ToRight As Boolean = False)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ SequenceToRng 함수
'▶ 순번을 범위로 반환합니다.
'▶ 인수 설명
'_____________startRng      : 배열을 반환할 기준 범위(셀) 입니다.
'_____________Count          : 배열로 반환할 순번의 갯수입니다.
'_____________StartNo        : [선택인수] 순번의 시작 번호입니다. 기본값은 1 입니다.
'_____________Increment    : [선택인수]순번이 증가 또는 감소하는 차이값입니다. 기본값은 1 입니다.
'_____________ToRight        : [선택인수] True일 경우 순번을 오른쪽 방향으로 반환합니다. 기본값은 False(=아래방향)입니다.
'▶ 사용 예제
'SequenceToRng Range("A1")
'##############################################################

Dim Arr As Variant: Dim v As Double: v = StartNo - Increment

If ToRight = False Then ReDim Arr(1 To Count, 1 To 1) Else ReDim Arr(1 To 1, 1 To Count)

If ToRight = False Then
    For i = 1 To Count
        v = v + Increment
        Arr(i, 1) = v
    Next
Else
    For i = 1 To Count
        v = v + Increment
        Arr(1, i) = v
    Next
End If

If ToRight = False Then startRng.Cells(1, 1).Resize(Count) = Arr Else startRng.Cells(1, 1).Resize(1, Count) = Arr

End Sub

Sub ValueToRng(startRng As Range, Count As Long, Value, Optional ToRight As Boolean = False)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ValueToRng 함수
'▶ 고정된 값을 범위에 뿌려줍니다.
'▶ 인수 설명
'_____________startRng      : 값을 뿌려줄 기준 셀 입니다.
'_____________Count          : 뿌려줄 값의 갯수입니다.
'_____________Value           : 뿌려줄 값 입니다.
'_____________ToRight        : [선택인수] True일 경우 값을 오른쪽 방향으로 뿌려줍니다. 기본값은 False(=아래방향)입니다.
'▶ 사용 예제
'ValueToRng Range("A1"), 10, "A"  '<- A1:A10 범위에 "A"를 출력합니다.
'##############################################################

If ToRight = False Then startRng.Cells(1, 1).Resize(Count) = Value Else startRng.Cells(1, 1).Resize(1, Count) = Value

End Sub

Sub RunningSumRng(startRng As Range, Count As Long, _
                                    Optional Offset_Add As Long = -1, Optional Offset_Deduct As Long = 0, _
                                    Optional blnReverse As Boolean = False)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ RunningSumRng 함수
'▶ 시작셀을 기준으로 더할위치/뺄위치를 지정하여 누계를 계산합니다.
'▶ 인수 설명
'_____________startRng               : 누계를 계산할 기준 셀입니다.
'_____________Count                   : 누계를 계산할 범위의 갯수입니다.
'_____________Offset_Add          : 더할 값이 입력된 열의 상대 위치입니다. (음수는 왼쪽방향, 양수는 오른쪽방향입니다. 기본값은 -1, 한칸 왼쪽에 있는 값을 더합니다.)
'_____________Offset_Deduct     : [선택인수] 뺄 값이 입력된 열의 상대위치입니다. 기본값은 없음입니다.
'_____________blnReverse            : [선택인수] True일 경우 시작셀을 맨 아래로 부터 시작하여 위로 올라가며 누계를 계산합니다. 기본값은 False 입니다.
'▶ 사용 예제
'RunningSumRng Range("C1"), 10,   '<- C1:C10 범위에 B1:B10을 참조하여 누계를 계산합니다.
'##############################################################

Dim T As Double
Dim vArr As Variant
Dim fR As Single: Dim fS As Long: Dim fE As Long

If blnReverse = False Then fR = 1 Else fR = -1
If Count < 1 Then Count = 1

ReDim vArr(1 To Count, 1 To 1)
    If fR = 1 Then fS = 1: fE = Count Else fS = Count: fE = 1
    
    If Offset_Deduct <> 0 Then
        For i = 1 To Count
            T = T + startRng.Offset((i - 1) * fR, Offset_Add).Value - startRng.Offset((i - 1) * fR, Offset_Deduct).Value
            vArr(i, 1) = T
        Next
    Else
        For i = 1 To Count
            T = T + startRng.Offset((i - 1) * fR, Offset_Add).Value
            vArr(i, 1) = T
        Next
    End If

If fR = 1 Then
    startRng.Resize(Count) = vArr
Else
    fE = UBound(vArr, 1)
    fS = LBound(vArr, 1)
    For i = fS To (fE - fS) \ 2 + fS
        T = vArr(fE, 1)
        vArr(fE, 1) = vArr(i, 1)
        vArr(i, 1) = T
        fE = fE - 1
    Next
    startRng.Offset(-Count + 1).Resize(Count) = vArr
End If

End Sub

Function IsUniqueArray(Arr As Variant, Optional ColNo As String = "") As Boolean

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ IsUniqueArray 함수
'▶ 배열에서 지정한 열이 하나의 값으로만 입력되어 있는지 확인합니다.
'▶ 인수 설명
'_____________Arr               : 배열입니다.
'_____________ColNo          : [선택인수] 하나의 값만 입력되어 있는지 확인할 열 번호입니다. 쉼표로 구분하여 여러개의 열을 지정할 수 있습니다. AND 조건으로 고유여부를 조회합니다. 기본값은 배열의 최초 열번호입니다.
'▶ 사용 예제
'Debug.Print IsUniqueArray (DB, 2)  '<- 배열의 두번째 열의 값이 하나로만 이루어져있는지 확인합니다. '▶ 사용된 보조함수 'ArrayDimension 함수 '############################################################## Dim D As Long: Dim i As Long Dim c As Variant Dim vCols As Variant: Dim vCol As Variant Dim sTemp As String D = ArrayDimension(Arr) If ColNo = "" Then If D > 1 Then ColNo = LBound(Arr, 2)
vCols = Split(ColNo, ",")

If D = 1 Then
    c = Arr(LBound(Arr))
    For i = LBound(Arr) To UBound(Arr)
        If Arr(i) <> c Then IsUniqueArray = False: Exit Function
    Next
Else
    For Each vCol In vCols
        sTemp = sTemp & Arr(LBound(Arr, 1), CLng(Trim(vCol)))
    Next
    c = sTemp
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        sTemp = ""
        For Each vCol In vCols
            sTemp = sTemp & Arr(i, CLng(Trim(vCol)))
        Next
        If c <> sTemp Then IsUniqueArray = False: Exit Function
    Next
End If

IsUniqueArray = True

End Function
Function IsDistinctArray(Arr As Variant, Optional ColNo As String = "") As Boolean

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ IsDistinctArray 함수
'▶ 배열에서 지정한 열의 값들이 모두 고유한 값들만 입력되어 있는지 확인합니다.
'▶ 인수 설명
'_____________Arr               : 배열입니다.
'_____________ColNo          : [선택인수] 값들이 고유한지 여부를 조회할 열 번호입니다. 쉼표로 구분하여 여러개의 열을 지정할 수 있습니다. AND 조건으로 고유여부를 조회합니다. 기본값은 배열의 최초 열번호입니다.
'▶ 사용 예제
'Debug.Print IsDistinctArray(DB, 2)  '<- 배열의 두번째 열의 값들이 고유한지 검사합니다. '▶ 사용된 보조함수 'ArrayDimension 함수 '############################################################## Dim Dict As Dictionary Dim vCols As Variant: Dim vCol As Variant Dim sTemp As String: Dim i As Long Set Dict = New Dictionary If ColNo = "" Then If ArrayDimension(Arr) > 1 Then ColNo = LBound(Arr, 2)

vCols = Split(ColNo, ",")

On Error GoTo Duplicate:

If ArrayDimension(Arr) = 1 Then
    For i = LBound(Arr) To UBound(Arr)
        Dict.Add Arr(i), 0
    Next
Else
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        sTemp = ""
        For Each vCol In vCols
            sTemp = sTemp & Arr(i, CLng(Trim(vCol)))
        Next
        Dict.Add sTemp, 0
    Next
End If

IsDistinctArray = True

Exit Function

Duplicate:
    IsDistinctArray = False

End Function

Sub ClearContentsBelow(startRng As Range, Optional ColNo, Optional BaseCol As Long = 0)

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ClearContentsBelow 함수
'▶ 기준셀부터 특정열까지 아래로 입력된 데이터를 모두 초기화합니다. (값만 초기화되며 서식은 그대로 유지됩니다.)
'▶ 인수 설명
'_____________startRng      : 기준셀입니다.
'_____________ColNo          : [선택인수] 기준셀로부터 삭제될 열번호(또는 알파벳)입니다. 기본값은 기준셀로부터 연속된 범위의 우측 마지막셀 열번호를 반환합니다.
'_____________BaseCol       : [선택인수] 기준셀 아래로 연속된 데이터를 참조할 기준열번호 입니다. 기본값은 기준셀의 열번호입니다.
'▶ 사용 예제
'ClearContentsBelow Range("A5"), "F"   '<- A5~F열까지 아래로 입력된 데이터를 초기화합니다.
'##############################################################

Dim WS As Worksheet: Dim lastRow As Long: Set WS = startRng.Parent
If IsMissing(ColNo) Then ColNo = WS.Cells(startRng.Row, WS.Columns.Count).End(xlToLeft).Column
If Not IsNumeric(ColNo) Then ColNo = Range(ColNo & 1).Column
If BaseCol = 0 Then BaseCol = startRng.Column Else BaseCol = startRng.Column + BaseCol - 1
lastRow = WS.Cells(WS.Rows.Count, BaseCol).End(xlUp).Row
If lastRow < startRng.Row Then Exit Sub
WS.Range(startRng, WS.Cells(lastRow, ColNo)).ClearContents

End Sub

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ArrayDimension 함수
'▶ 배열의 차원수를 반환합니다.
'▶ 인수 설명
'_____________vaArray     : 차원을 검토할 배열을 입력합니다.
'###############################################################
Function ArrayDimension(vaArray As Variant) As Integer
 
Dim i As Integer: Dim X As Integer
 
On Error Resume Next
 
Do
    i = i + 1
    X = UBound(vaArray, i)
Loop Until Err.Number <> 0
 
Err.Clear
 
ArrayDimension = i - 1
 
End Function

Function ShapeInRange(Rng As Range, _
                Optional iRed As Long = 255, _
                Optional iGreen As Long = 0, _
                Optional iBlue As Long = 0, _
                Optional FillVisible As MsoTriState = msoTrue, _
                Optional LineVisible As MsoTriState = msoTrue, _
                Optional Transparent As Double = 0.95, _
                Optional LineWeight As Double = 0.5, _
                Optional DashType As MsoLineDashStyle = msoLineDash, _
                Optional ShapeType As MsoAutoShapeType = msoShapeRectangle, _
                Optional ActivateSheet As Boolean = True) As Shape

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
'
'■ ShapeInRange 명령문
'■ 선택된 범위 안에 도형을 삽입합니다.
'■ 사용방법
''아래 명령문을 유저폼 모듈안에 붙여넣기 한 뒤, '리스트박스' 를 실제 적용할 리스트박스 이름으로 변경합니다.
''----------------------------------------------------------------------------------------------------
'Dim Shp As Shape
'Set Shp = ShapeInRange(Range("A1"))
''-----------------------------------------------------------------------------------------------------
'▶ 인수 설명
'_____________Rng               : 도형을 삽입할 범위입니다.
'_____________iRed               : [선택인수] 삽입할 도형의 RGB, R 값입니다. 기본값은 255 입니다.
'_____________iGreen           : [선택인수] 삽입할 도형의 RGB, G 값입니다. 기본값은 0 입니다.
'_____________iBlue              : [선택인수] 삽입할 도형의 RGB, B 값입니다. 기본값은 0 입니다.
'_____________FillVisible       : [선택인수] 채우기 여부입니다. 기본값은 TRUE 입니다.
'_____________LineVisible     : [선택인수] 윤곽선 여부입니다. 기본값은 TRUE 입니다.
'_____________Transparent  : [선택인수] 채우기 투명도입니다. 기본값은 0.25 입니다.
'_____________LineWeight   : [선택인수] 윤곽선 두께입니다. 기본값은 0.5 입니다.
'_____________DashType      : [선택인수] 윤곽선 스타일입니다. 기본값은 점선입니다.
'_____________ShapeType    : [선택인수] 도형 모양입니다. 기본값은 직사각형입니다.
'_____________AvtiveSheet   : [선택인수] 도형삽입 후 삽입된 시트 활성화여부입니다. 기본값은 True 입니다.
'###############################################################

Dim Shp As Shape
Dim WS As Worksheet

Set WS = Rng.Parent

With Rng
    Set Shp = WS.Shapes.AddShape(ShapeType, .left, .top, .Width, .Height)
End With

With Shp
    With .Fill
        .Visible = FillVisible
        .ForeColor.RGB = RGB(iRed, iGreen, iBlue)
        .Transparency = Transparent
    End With
    With .Line
        .Visible = LineVisible
        .ForeColor.RGB = RGB(iRed, iGreen, iBlue)
        .Weight = LineWeight
        .DashStyle = DashType
    End With
End With

Set ShapeInRange = Shp
If ActivateSheet = True Then Shp.Parent.Activate

End Function

리스트박스/콤보박스/유저폼 관련 명령문

리스트박스·콤보박스·유저폼 핸들링 명령문을 사용하면 엑셀 유저폼의 리스트박스와 콤보박스 컨트롤을 더욱 간편하게 제어할 수 있습니다.

리스트/콤보박스/유저폼 핸들링 함수 목록

유저폼/리스트박스/콤보박스 핸들링 관련 함수 전체 명령문

아래 명령문을 새로운 모듈에 붙여넣기 후 사용합니다.

Option Explicit

'########################
' 콤보박스를 DB 값으로 갱신
' Update_Cbo cboBox, DB, "1"
'########################
Sub Update_Cbo(cboBox As MSForms.ComboBox, DB As Variant, Optional DisplayCol As Long = 1, Optional SetDefault As Boolean = False)

Dim colCount As Long
Dim colWidths As String
Dim i As Long

colCount = UBound(DB, 2)

With cboBox
    .ColumnCount = colCount
    For i = 1 To colCount
        If DisplayCol = i Then colWidths = colWidths & .Width - 15 & "," Else colWidths = colWidths & "0,"
    Next
    colWidths = left(colWidths, Len(colWidths) - 1)
    .List = DB
    .ColumnWidths = colWidths
    If SetDefault = True Then .ListIndex = 0
End With

End Sub

'########################
' 콤보박스의 특정 필드 값을 참조하여 값을 선택
' Select_CboItm cboBox, 1, 1
'########################
Sub Select_CboItm(cboBox As MSForms.ComboBox, ID, Optional ColNo As Long = 1)

Dim i As Long

If IsNumeric(ID) Then ID = CLng(ID)

With cboBox
    For i = 0 To .ListCount - 1
        If .List(i, ColNo - 1) = ID Then .ListIndex = i
    Next
End With

End Sub

'########################
' 리스트박스를 DB 값으로 갱신
' Update_List ListBox, DB, "0pt; 80pt; 50pt"
'########################
Sub Update_List(lstBox As MSForms.ListBox, DB As Variant, Widths As String)

With lstBox
    .Clear
    .ColumnWidths = Widths
    If Not IsEmpty(DB) Then
        .ColumnCount = UBound(DB, 2)
        .List = DB
    End If
End With

End Sub

'########################
' 리스트박스의 아이템 목록을 배열로 반환
' Array = Get_ListItm listbox
'########################
Function Get_ListItm(lstBox As Control, Optional blnAll As Boolean = False) As Variant

Dim i As Long: Dim j As Long
Dim vaArr As Variant

    With lstBox
        If blnAll = False Then
            If .ListIndex <> -1 Then
            ReDim vaArr(0 To .ColumnCount - 1)
                For i = 0 To .ListCount - 1
                    If .Selected(i) Then
                        For j = 0 To .ColumnCount - 1
                            vaArr(j) = .List(i, j)
                        Next
                        Exit For
                    End If
                Next
            End If
        Else
            ReDim vaArr(0 To .ListCount - 1, 0 To .ColumnCount - 1)
                For i = 0 To .ListCount - 1
                    For j = 0 To .ColumnCount - 1
                        vaArr(i, j) = .List(i, j)
                    Next
                Next
        End If
    End With

Get_ListItm = vaArr

End Function

'########################
' 리스트박스의 첫번째필드 ID를 참조하여 해당 ID 값을 선택
' Select_ListItm ListBox, ID
'########################
Function Select_ListItm(lstBox As Control, ID, Optional ColNo As Long = 1)

Dim i As Long

If IsNumeric(ID) Then ID = CLng(ID)

With lstBox
    For i = 0 To .ListCount - 1
        If .List(i, ColNo - 1) = ID Then .Selected(i) = True: Exit For
    Next
End With

End Function

'########################
' 리스트박스 활성화
' Active_ListBox ( ListBox, Select_ListItm(ListBox, ID) )
'########################
Function Active_ListBox(lstBox As Control, Optional Index As Long = 0)

If lstBox.ListCount > 0 Then lstBox.Selected(Index) = True

End Function

'########################
' 현재 선택된 값의 순번 확인
' i = Get_ListIndex(ListBox)
'########################
Function Get_ListIndex(lstBox As Control)

Dim i As Long
With lstBox
    If .ListIndex <> -1 Then
        For i = 0 To .ListCount - 1
            If .Selected(i) Then Get_ListIndex = i: Exit For
        Next
    End If
End With

End Function

'########################
' 리스트 박스가 선택되어 있는지 여부 확인
' boolean = isListBoxSelected(ListBox1)
'########################

Function isListBoxSelected(ListBox As MSForms.ListBox) As Boolean
 
Dim i As Long
 
For i = 0 To ListBox.ListCount - 1
If ListBox.Selected(i) Then isListBoxSelected = True: Exit Function
Next
 
isListBoxSelected = False
 
End Function
 
 '########################
' 유저폼에서 해당 컨트롤 버튼 값 초기화
' Clear_Ctrls ( Userform1, "Label", "이름" )  ' 유저폼에서 "이름"이 들어가는 라벨 제외 모든 label 제거
' 컨트롤 이름에는 와일드카드(*,?) 사용가능 (예: txt* 는 txt로 시작하는 모든 버튼을 의미)
' 컨트롤 종류 :
' Label, Frame, TextBox, CommandButton, ComboBox, TabStrip, ListBox,
' MultiPage, CheckBox, ScrollBar, OptionButton, SpinButton, ToggleButton, Image
'########################
Sub Clear_Ctrls(frm As UserForm, CtlType As String, Optional Exclude As String)

Dim ctl As Control
Dim Excs As Variant: Dim Exc As Variant
Dim blnPass As Boolean
Dim vaType As Variant: Dim vType As Variant

If InStr(1, Exclude, ",") > 0 Then: Excs = Split(Exclude, ","): Else Excs = Array(Exclude)
If InStr(1, CtlType, ",") > 0 Then: vaType = Split(CtlType, ","): Else vaType = Array(CtlType)

For Each vType In vaType
    For Each ctl In frm.Controls
        If ctl.Name Like Trim(vType) Then
            blnPass = False
            For Each Exc In Excs
                If ctl.Name Like Trim(Exc) Then blnPass = True: Exit For
            Next
            If blnPass = False Then ctl.Value = ""
        End If
    Next
Next

End Sub

 '########################
' 유저폼의 컨트롤 중 비어있는 컨트롤이 있는지 확인(오류방지)
' blnCheck = IsEmpty_Ctrls ( Userform1, "Label", "이름" )  ' 유저폼에서 "이름"이 들어가는 라벨 제외 모든 label 제거
' 컨트롤 이름에는 와일드카드(*,?) 사용가능 (예: txt* 는 txt로 시작하는 모든 버튼을 의미)
' 컨트롤 종류 :
' Label, Frame, TextBox, CommandButton, ComboBox, TabStrip, ListBox,
' MultiPage, CheckBox, ScrollBar, OptionButton, SpinButton, ToggleButton, Image
'########################
Function IsEmpty_Ctrls(frm As UserForm, CtlType As String, Optional Exclude As String)

Dim ctl As Control
Dim vaType As Variant: Dim vType As Variant

If InStr(1, CtlType, ",") > 0 Then: vaType = Split(CtlType, ","): Else vaType = Array(CtlType)

For Each vType In vaType
    For Each ctl In frm.Controls
        If ctl.Name Like Trim(vType) And ctl.Name <> Exclude Then
            If ctl.Value = "" Then IsEmpty_Ctrls = True: Exit Function
        End If
    Next
Next

IsEmpty_Ctrls = False

End Function

스크롤 휠 적용 모듈 명령문

VBA 유저폼에 추가한 콤보박스와 리스트박스는 기본 상태에서 마우스 휠 스크롤이 동작하지 않습니다. 아래 명령문을 유저폼에 추가하면 콤보박스와 리스트박스에서 마우스 휠 스크롤을 사용할 수 있습니다.

마우스 휠 스크롤 관련 함수 목록

마우스 휠 스크롤 관련 함수 전체 명령문

아래 명령문을 새로운 모듈에 붙여넣기 후 사용합니다.

Option Explicit

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'수정 및 배포 시 출처를 반드시 명시해야 합니다.
'
'■ HookListBoxScroll & UnHookListBoxScroll 명령문
'■ 유저폼에 사용된 리스트박스가 마우스 휠로 스크롤 되도록 후킹 / 후킹해제하는 명령문입니다.
'■ 사용방법
''아래 명령문을 유저폼 모듈안에 붙여넣기 한 뒤, '리스트박스' 를 실제 적용할 리스트박스 이름으로 변경합니다.
''----------------------------------------------------------------------------------------------------
'Private Sub 리스트박스_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'UnhookListBoxScroll
'End Sub
'Private Sub 리스트박스_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'HookListBoxScroll Me, Me.리스트박스
'End Sub
''-----------------------------------------------------------------------------------------------------
'
'본 명령문은 아래 링크를 참조하여 작성된 명령문입니다.
'https://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba
'###############################################################

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type MOUSEHOOKSTRUCT
        pt As POINTAPI
        hwnd As Long
        wHitTestCode As Long
        dwExtraInfo As Long
End Type

#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As LongPtr
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
#End If

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As LongPtr = &H20A
Private Const HC_ACTION As LongPtr = 0
Private Const GWL_HINSTANCE As LongPtr = (-6)

Private mLngMouseHook As LongPtr
Private mListBoxHwnd As LongPtr
Private mbHook As Boolean
Private mCtl As MSForms.Control
Dim n As LongPtr

Sub HookListBoxScroll(frm As Object, ctl As MSForms.Control)
Dim lngAppInst As LongPtr
Dim hwndUnderCursor As LongPtr
Dim tPT As POINTAPI
     GetCursorPos tPT
     hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
     If Not frm.ActiveControl Is ctl Then
             ctl.SetFocus
     End If
     If mListBoxHwnd <> hwndUnderCursor Then
             UnhookListBoxScroll
             Set mCtl = ctl
             mListBoxHwnd = hwndUnderCursor
             lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
             If Not mbHook Then
                     mLngMouseHook = SetWindowsHookEx( _
                                                     WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
                     mbHook = mLngMouseHook <> 0
             End If
     End If
End Sub

Sub UnhookListBoxScroll()
     If mbHook Then
                Set mCtl = Nothing
             UnhookWindowsHookEx mLngMouseHook
             mLngMouseHook = 0
             mListBoxHwnd = 0
             mbHook = False
        End If
End Sub

Private Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
Dim idx As LongPtr
        On Error GoTo errH
     If (nCode = HC_ACTION) Then
             If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then
                     If wParam = WM_MOUSEWHEEL Then
                                MouseProc = True
                                If lParam.hwnd > 0 Then idx = -1 Else idx = 1
                             idx = idx + mCtl.TopIndex
                             If idx >= 0 Then mCtl.TopIndex = idx
                                Exit Function
                     End If
             Else
                     UnhookListBoxScroll
             End If
     End If
     MouseProc = CallNextHookEx( _
                             mLngMouseHook, nCode, wParam, ByVal lParam)
     Exit Function
errH:
     UnhookListBoxScroll
End Function