엑셀 재고관리 프로그램 만들기 - VBA 매크로 필수 기능 총정리

엑셀 VBA 매크로를 활용하여 현업에서 바로 사용할 수 있는 재고관리 프로그램 제작 방법을 처음부터 끝까지 단계별로 살펴봅니다.

홈페이지 » 엑셀 재고관리 프로그램 만들기 - VBA 매크로 필수 기능 총정리

엑셀 재고관리 프로그램 만들기 - 실무 핵심기능 총정리

엑셀 재고관리 프로그램 만들기 목차 바로가기
영상 강의
  1. ------ 1일차 ------
  2. 1. 강의 시작
    00:00
  3. 1-1. 강의에서 다룰 내용
    02:38
  4. 1-2. 데이터 구조 살펴보기
    03:47
  5. 1-3. 개발도구 활성화하기
    07:26
  6. 1-4. 거래처 관리 유저폼 만들기
    08:07
  7. 1-5. 유저폼 컨트롤 설정하기
    22:01
  8. 1-6. 유저폼 출력 명령문
    25:26
  9. 1-7. 거래처 목록 출력 명령문
    28:11
  10. 1-8. Get_DB 명령문 동작원리
    30:42
  11. 1-9. 리스트박스에 거래처목록 추가하기
    34:03
  12. 1-10. 선택된 거래처를 텍스트 상자에 표시하기
    38:43
  13. 1-11. 주소 입력 상자에 여러줄 입력하기
    44:15
  14. 1-12. 거래처 수정 버튼 클릭 이벤트
    44:57
  15. 1-13. Update_Record 명령문 동작원리
    48:03
  16. 1-14. 거래처 수정 명령문 작성
    50:19
  17. 1-15. 거래처 수정 명령문 다듬기
    54:44
  18. 1-16. 수정 완료 안내문구 띄우기
    57:46
  19. 1-17. 텍스트박스 초기화 명령문
    59:16
  20. 1-18. 거래처 등록 명령문
    01:01:01
  21. 1-19. 버튼 클릭할 때 마우스 모양 설정하기
    01:07:08
  22. 1-20. 거래처 정보 삭제 명령문
    01:08:07
  23. 1-21 삭제 전 안내메세지 출력
    01:10:28
  24. 1-22 거래처 목록 실시간 필터링
    01:14:09
  25. 1-23 유저폼 종료 명령문
    01:17:42
  26. 1-24 유저폼 스타일 꾸미기
    01:19:51
  27. 1-25 거래처 등록 오류 처리
    01:25:40
  28. ------ 2일차 ------
  29. 2. 강의에서 알아볼 내용
    01:28:10
  30. 2-1. 콤보박스/드롭다운 사용법 기초
    01:32:02
  31. 2-2. 거래처 관리 양식 편의성 개선
    01:34:42
  32. 2-3. 제품관리 유저폼 컨트롤버튼 추가
    01:46:40
  33. 2-4. 목록상자 초기화 명령문
    01:52:50
  34. 2-5. 콤보박스 초기화 명령문
    02:02:13
  35. 2-6. 제품관리 유저폼 닫기 명령문
    02:10:33
  36. 2-7. 제품 목록 클릭 이벤트
    02:11:43
  37. 2-8. 제품 입력란 초기화 명령문
    02:20:58
  38. 2-9. 제품 등록 명령문
    02:23:51
  39. 2-10. 제품 코드 중복여부 확인 명령문
    02:29:25
  40. 2-11. 제품 정보 수정 명령문
    02:34:02
  41. 2-12. 제품 코드 수정시 중복여부 확인
    02:38:10
  42. 2-13. 제품 정보 삭제 명령문
    02:44:59
  43. 2-14. 제품 목록 필터링 명령문
    02:48:34
  44. 2-15. 제품 관리 유저폼 완성
    02:51:15
  45. ------ 3일차 ------
  46. 3. 강의에서 알아볼 내용
    02:54:23
  47. 3-1. 이번 강의와 관련된 VBA 기초이론
    02:56:52
  48. 3-2. UsedRange 속성 알아보기
    02:59:42
  49. 3-3. Columns 속성 알아보기
    03:03:24
  50. 3-4. Range.Find 함수 알아보기
    03:04:53
  51. 3-5. Resize 속성 알아보기
    03:10:05
  52. 3-6. Offset 속성 알아보기
    03:14:50
  53. 3-7. Range.Insert 함수 알아보기
    03:18:12
  54. 3-8. 제품구분, 단위관리 유저폼 살펴보기
    03:23:30
  55. 3-9. 제품-거래처 유저폼 연동
    03:25:31
  56. 3-10. 실행 방식에 따른 유저폼양식 변경
    03:30:51
  57. 3-11. 리스트박스 클릭 이벤트 문제 해결
    03:44:54
  58. 3-12. 제품-거래처 유저폼 연동 확인
    03:52:09
  59. 3-13. 제품-단위관리 유저폼 연동
    03:52:56
  60. 3-14. 제품구분 관리 유저폼 만들기
    03:55:56
  61. 3-15. 제품구분 유저폼 실행 명령문
    03:56:56
  62. 3-16. 제품구분 리스트박스 클릭 명령문
    03:59:28
  63. 3-17. 제품구분 유저폼 종료 명령문
    04:02:25
  64. 3-18. 신규 제품구분 추가 명령문
    04:03:11
  65. 3-19. 제품구분 중복여부 확인
    04:06:03
  66. 3-20. 제품구분 수정 명령문
    04:09:09
  67. 3-21. 제품구분 삭제 명령문
    04:15:34
  68. 3-22. 제품구분 순서 이동 명령문
    04:18:28
  69. 3-23. 순서이동 명령문 오류처리
    04:26:04
  70. 3-24. 순서이동 명령문 - 아래방향
    04:28:52
  71. ------ 4일차 ------
  72. 4. 달력 유저폼 살펴보기
    04:34:24
  73. 4-1. 정렬 방식 기초 및 동작원리
    04:36:51
  74. 4-2. 이번 강의에서 사용된 보조함수
    04:41:22
  75. 4-3. 완성예제 살펴보기
    04:45:08
  76. 4-4. 이번 강의에서 만들 유저폼
    04:47:33
  77. 4-5. 달력 유저폼으로 날짜 받아오기
    04:49:49
  78. 4-6. 제품 선택 유저폼 만들기
    04:54:18
  79. 4-7. 선택한 제품을 입력하는 명령문
    04:56:21
  80. 4-8. 입출고 범위 초기화 명령문
    05:02:45
  81. 4-9. 입출고 자료 등록 명령문
    05:06:07
  82. 4-10. 재고 조회 명령문 동작원리
    05:14:42
  83. 4-11. 재고 조회 유저폼 만들기
    05:16:33
  84. 4-12. 달력 유저폼으로 날짜 받아오기
    05:29:20
  85. 4-13. 재고 조회 명령문 작성
    05:31:31
  86. 4-14. 범위에 순번을 추가하는 명령문
    05:45:09
  87. 4-15. 재고 조회 필터링 명령문
    05:48:25
  88. 4-16. 재고 조회 명령문 오류처리
    05:57:12
  89. 4-17. 재고 출력범위 초기화 명령문
    06:00:11
  90. 4-18. 입출고 날짜 기준 정렬하기
    06:06:50
  91. 4-19. 재고 출력범위 초기화 버튼
    06:12:06
  92. 4-20. 입출고 등록시 누락데이터 처리
    06:13:09
  93. ------ 5일차 ------
  94. 5. 지난 완성파일과 달라진 부분
    06:16:41
  95. 5-1. 완성파일 살펴보기
    06:21:21
  96. 5-2. 현 재고상황 조회 명령문
    06:23:41
  97. 5-3. 현 보유중인 재고만 출력하기
    06:37:32
  98. 5-4. 현 재고조회 명령문 오류처리
    06:38:58
  99. 5-5. 재고목록 순번-일자 출력
    06:41:45
  100. 5-6. 열 숨기기-해제 명령문
    06:44:02
  101. 5-7. 재고목록 - 누계 계산하기
    06:47:53
  102. 5-8. RunningSumRng 함수 사용법
    06:52:45
  103. 5-9. 재고 삭제 명령문
    06:56:54
  104. 5-10. 재고 수정 유저폼 만들기
    07:11:26
  105. 5-11. 완성된 프로그램 테스트
    07:21:17
  106. 5-12. 리스트박스에 스크롤 휠 추가
    07:23:19
  107. 5-13. 재고관리 프로그램 최종 테스트
    07:26:39
  108. 5-14. 선택된 범위 여러 재고 동시 삭제
    07:30:48
  109. 5-15. 메시지박스 알림음 제거
    07:33:21
큰 화면으로 보기

예제파일 다운로드

오빠두엑셀의 강의 예제파일은 여러분을 위해 자유롭게 제공하고 있습니다.

  • [VBA프로젝트] 엑셀 재고관리 프로그램 만들기
    예제파일
  • [VBA프로젝트] 엑셀 재고관리 프로그램 만들기
    완성파일
  • [VBA프로젝트] 엑셀 재고관리 프로그램 만들기
    보충파일

.

라이브 강의 전체영상도 함께 확인해보세요!

위캔두 회원이 되시면 매주 오빠두엑셀에서 진행하는 라이브강의 풀영상을 확인하실 수 있습니다.


.

이전 강의 살펴보기 👇👇

이전 강의를 아직 못 보셨다면, 아래 강의를 미리 확인해주세요!
이번 강의를 이해하시는데 큰 도움이 됩니다.


강의 안내

이번 강의는 엑셀 VBA를 활용하여 실무에서 바로 사용할 수 있는 재고관리 프로그램을 처음부터 끝까지 직접 완성하는 풀스택(DB관리→유저폼제작) 강의입니다. 다루는 내용이 많아 모든 단계를 글로 옮기기에는 어려움이 있어, 각 섹션별로 사용된 중요 명령문을 모아 아래에 정리해드렸습니다. 강의 중 잘못된 부분이나 자주 묻는 질문은 아래 주기적으로 업데이트 할 예정입니다.

  1. 예제파일과 완성파일에는 강의에서 사용된 "보조 명령문이 모두 포함"되어 있습니다. 따라서 예제파일을 다운받으신 뒤, 영상강의를 따라 차례대로 진행해주세요.
  2. 강의에 사용된 전체 보조 명령문은 PDF 보충파일에 정리해드렸습니다.
  3. PDF 파일에 적힌 명령문을 복사/붙여넣기 시 줄바꿈 문제로 빨간색으로 오류가 발생할 경우, 게시글 아래에 적어드린 명령문을 사용해주세요.

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

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

질문을 남겨 주실 때에는 아래 내용을 함께 작성해주시면 더욱 빠르고 정확한 답변을 드릴 수 있습니다.

  1. 영상 시간대
  2. 전체 명령문
  3. 오류가 발생하는 부분
  4. 전체 오류 구문

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


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

Get_DB 함수는 표의 머리글 오른쪽으로 최대 ID가 있다고 가정하고 동작합니다. 따라서 표 머리글 오른쪽으로 최대 ID가 없을 경우, ID없음을 TRUE로 사용합니다.

엑셀 get_Db 함수 오류
GET_DB 함수는 표 오른쪽으로 최근 ID가 있다는 가정하에 동작합니다.

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

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

Filtered_DB 함수 전체 명령문 & 상세 설명 - 바로가기
예) DB = Filtered_DB(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 관련 함수 목록
함수 설명
Insert_Record 시트에 새로운 행을 추가합니다.
Update_Record 시트에서 특정 ID를 갖는 데이터를 갱신 합니다.
Delete_Record 시트에서 특정 ID를 갖는 데이터를 삭제합니다.
Get_DB 시트에 범위로 입력된 데이터를 배열로 반환합니다.
Connect_DB 기존 배열과 새로운 시트를 연결한 관계형 DB를 배열로 반환합니다.
Filtered_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 스타일 유저폼 명령문에 대한 자세한 설명 및 사용법은 아래 영상강의를 참고해주세요.

윈도우 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차원 배열을 정렬하거나 시트 위로 출력하는 작업 또는 순번을 범위로 출력하는 등의 다양한 작업을 손쉽게 처리할 수 있습니다.

배열/범위 핸들링 함수 목록
함수 설명
Sort2dArray 2차원 배열을 특정 필드 기준으로 오름차순/내림차순 정렬합니다.
IsUniqueArray 각 배열이 하나의 값으로만 이루어져 있는지 확인합니다. (예: 1,1,1,1..)
IsDistinctArray 각 배열이 고유값으로 이루어져 있는지 확인합니다. (예: 1,2,3,4..)
ArrayToRng DB 배열을 시트 범위로 출력합니다.
SequenceToRng 시트 범위 위로 순번을 출력합니다.
ValueToRng 시트 범위 위로 정해진 값을 출력합니다.
RunningSumRng 시작 셀을 기준으로 더할 곳(+)과 뺄 곳(-)을 지정하여 누계를 계산합니다.
ShapeInRange 지정한 범위가 강조 되도록 범위 위에 도형을 삽입합니다.
ClearContentsBelow 지정한 범위 아래로 입력된 데이터를 초기화합니다.
배열/범위 핸들링 함수 전체 명령문

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

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

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

리스트박스/콤보박스/유저폼 핸들링 명령문을 사용하면 엑셀 유저폼에 사용하는 리스트박스와 콤보박스 개체를 보다 편리하게 제어할 수 있습니다.

리스트/콤보박스/유저폼 핸들링 함수 목록
함수 설명
Update_Cbo DB 데이터를 콤보박스에 추가합니다.
Select_CboItm 여러 필드로 입력된 콤보박스에서 특정 값을 선택합니다.
Update_List DB 데이터를 리스트박스에 추가합니다.
Get_ListItm 리스트박스 목록을 DB로 반환합니다.
Select_ListItm 특정 ID를 갖는 리스트박스 값을 배열로 반환합니다.
Active_ListBox 리스트박스를 활성화합니다.
Get_ListIndex 현재 리스트박스에서 선택된 값의 순번을 반환합니다.
isListBoxSelected 리스트박스가 현재 활성화되어 있는지 확인합니다.
Clear_Ctrls 선택한 컨트롤의 값을 모두 초기화합니다.
IsEmpty_Ctrls 선택한 컨트롤의 값이 모두 입력되어 있는지 확인합니다.
유저폼/리스트박스/콤보박스 핸들링 관련 함수 전체 명령문

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

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 유저폼에 추가한 콤보박스와 리스트박스는 그냥 사용할 경우 마우스 휠 기능을 이용할 수 없습니다. 따라서 아래 명령문을 유저폼에 추가하면 콤보박스와 리스트박스에 마우스 휠 기능을 적용할 수 있습니다.

마우스 휠 스크롤 관련 함수 목록
함수 설명
HookListBoxScroll 리스트박스의 마우스 휠 스크롤을 활성화 합니다.
(MouseMove 이벤트에 추가합니다.)
UnHookListBoxScroll 리스트박스에 적용된 마우스 휠 이동을 비활성화 합니다.
(Exit 이벤트에 추가합니다.)
마우스 휠 스크롤 관련 함수 전체 명령문

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

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
5 21 투표
게시글평점
guest
35 댓글
Inline Feedbacks
모든 댓글 보기
iviolin200
iviolin200
2021년 7월 16일 9:40 오전
게시글평점 :
     

영상 잘 보고있었는데 비공개로 바뀌었네요. 언제 다시 볼 수 있을까요?

나상명
나상명
2021년 7월 16일 10:58 오전
게시글평점 :
     

위캔두 회원가입해서 영상을 재생했는데 비공개 동영상으로 볼수가 없네요. 저만 그런거는 아니죠? ㅠㅠ

hano0701
hano0701
2021년 7월 16일 2:48 오후
게시글평점 :
     

일반회사원들의 한줄기 빛같은 오빠두님
정말 감사합니다. 동영상 정독해서 저도 재고관리프로그램을 한번 만들어보겠습니다.

이재원재석
이재원재석
2021년 7월 16일 5:38 오후
게시글평점 :
     

명령단추 색상 변경하는 것 좋습니다.

강문형(CJ대한통운 우이대리점)
강문형(CJ대한통운 우이대리점)
2021년 7월 17일 9:40 오전
게시글평점 :
     

항상 감사합니다.
지난 파워쿼리 강의도 지금 잘 활용중입니다
VBA는 처음인데 열심히 정독해서 파워쿼리와 같이 활용 해 보고 싶은 욕심이 생기네요.
이번 강의 내용을 파워쿼리와도 접목이 가능하겠죠?

요술쟁이
요술쟁이
2021년 7월 18일 2:39 오후
게시글평점 :
     

최종본 제품 돋보기 리스트박스 휠관련 오류가 뜹니다.
엑셀 2016 버전입니다. with문 관련 디버깅 오류가 뜨는데 왜 그런지 궁금하네요.

취급주의
취급주의
2021년 7월 19일 11:35 오전
게시글평점 :
     

귀한 자료 정말 감사드립니다. 열심히 배워서 잘 활용하겠습니다.

한강괴물
한강괴물
2021년 7월 19일 12:14 오후
게시글평점 :
     

진짜 혜자강의

천무등룡
천무등룡
2021년 7월 19일 2:05 오후
게시글평점 :
     

정말 잘 보고 도움이 많이 되고 있습니다. 데이타 처리시 품번과 품명, 색삭, 업체가 딱 정해진 데이타 처리는 어떻게 하는게 좋을까요?

오매불망
오매불망
2021년 7월 20일 9:04 오전
게시글평점 :
     

항상 감사하게 생각하고 있습니다.

강가딘
강가딘
2021년 7월 20일 9:51 오전
게시글평점 :
     

오늘 동영상 보고 파일 다운 받아 갑니다.
항상 좋은 자료 감사드립니다. 좋은 하루 되세요

최훈영
최훈영
2021년 7월 20일 1:35 오후
게시글평점 :
     

와 진짜 대단하세요. 대박 잘 응용해서 사용하겠습니다.

VBA 왕초보
VBA 왕초보
2021년 7월 21일 8:46 오전
게시글평점 :
     

좋은 강의 감사합니다.

  • 예제 프로그램 다운로드가 안되는데.. 어떻게 해야되나요??
VBA 왕초보
VBA 왕초보
2021년 7월 21일 10:12 오후
답글 남기기  오빠두엑셀

회사 보안관련 방화벽때문에 다운이 안되었네요. 오빠두엑셀님 도움으로 업무에 많은 도움이 되었습니다
감사합니다

Last edited 4 월 전 by VBA 왕초보
짱재영
짱재영
2021년 7월 21일 10:10 오전
게시글평점 :
     

우와 최고입니다

심규진
심규진
2021년 7월 22일 2:06 오후
게시글평점 :
     

최고입니다!!!!!!!

f****
f****
2021년 7월 23일 12:28 오전
답글 남기기  심규진

감사합니다!!!!

마녀
마녀
2021년 7월 29일 5:54 오후
게시글평점 :
     

영상 보면서 재고관리 프로그램을 만들고 있어요 궁금한게 있어서요. 저는 여러명이서 같이 사용하는 재고 프로그램을 만들고 있습니다 거래처정보를 access를 이용해 DB정리하고 있습니다. access에 있는 거래처 목록을 "재고관리"시트 "거래처관리"버튼 클릭하면 우측 거래처리스트에… 더보기 »

달사냥
달사냥
2021년 8월 10일 11:20 오후
게시글평점 :
     

정말 유용한 강의 였습니다...
한가지 에러가 보이길래 질문드립니다....
재고 조회 유저폼에서 당일 데이터가 없는 상태에서
검색 옵션을 당일로 체크하고 검색하면 에러가 납니다....
완성파일에서도 마찬가지라서 문의 드립니다.

chich****
chich****
2021년 8월 16일 5:11 오후
게시글평점 :
     

항상 너무 너무 감사합니다. 동영상 잘 정독해서 실력을 키워 보겠습니다.

쿠레
쿠레
2021년 9월 7일 11:00 오후
게시글평점 :
     

거래처 부분을 빼려고 하는데 어떻게 하면 될까요?? 연결연결 되어있어서 어디서부터 손을 대야할지 모르겠습니다.

미미얌
미미얌
2021년 9월 13일 4:50 오후
게시글평점 :
     

완성파일 5에 있는 프로모션은 뭘까요?
강의에서 아무리 찾아봐도 없네요

18274
18274
2021년 9월 27일 10:43 오후
게시글평점 :
     

안녕하세요 좋은 자료 정말 감사합니다

한번 시험 삼아 4일차 완성 파일을 가지고 임의대로 제품 입고 출고를

해 보았는데 잔고 수량이 안 나오더라고요 혹시 이 부분에 대해서

영상에 언급하신 게 있으실까요?

J.park
J.park
2021년 10월 24일 3:00 오후
게시글평점 :
     

댓글 삭제가 안되네요..

Last edited 1 월 전 by 올마이타
승승2
승승2
2021년 11월 2일 4:23 오후
게시글평점 :
     

항상 잘 보고 있습니다

35
0
여러분의 생각을 댓글로 남겨주세요.x