엑셀 선입선출 재고관리, 함수만으로 손쉽게 관리하는 방법

Option Explicit
 
Private Sub btnAdd_Click()
 
Dim i As Long: Dim j As Long
Dim db As Variant: Dim x As Long
 
If Me.lst3.ListIndex <> -1 Then
    Me.lst2.AddItem lst3.List(Me.lst3.ListIndex, 0)
    For i = 1 To 4
        With Me.lst2
            .List(.ListCount - 1, i) = Me.lst3.List(Me.lst3.ListIndex, i)
        End With
    Next
 
    ReDim db(0 To Me.lst1.ListCount - 1, 0 To 4)
    For i = 0 To Me.lst1.ListCount - 1
        For j = 0 To 4
            db(i, j) = Me.lst1.List(i, j)
        Next
    Next
 
    x = Get_ListRecord(db, 0, Me.lst3.List(Me.lst3.ListIndex, 0))
    Me.lst1.RemoveItem (x)
    Me.lst3.RemoveItem (Me.lst3.ListIndex)
End If
 
End Sub
 
Private Sub btnRemove_Click()
 
Dim i As Long
 
If Me.lst2.ListIndex <> -1 Then
    Me.lst1.AddItem lst2.List(Me.lst2.ListIndex, 0)
    Me.lst3.AddItem lst2.List(Me.lst2.ListIndex, 0)
    For i = 1 To 4
        With Me.lst1
            .List(.ListCount - 1, i) = Me.lst2.List(Me.lst2.ListIndex, i)
        End With
        With Me.lst3
            .List(.ListCount - 1, i) = Me.lst2.List(Me.lst2.ListIndex, i)
        End With
    Next
 
    Me.lst2.RemoveItem (lst2.ListIndex)
End If
 
 
End Sub
 
Private Sub btnSubmit_Click()
 
Dim i As Long: Dim j As Long: Dim x As Long
Dim vbyn As VbMsgBoxResult
 
vbyn = MsgBox("출고 등록하시겠습니까", vbYesNo)
If vbyn = vbYes Then
    With Sheet6
        .Range("I4:M15").ClearContents
    End With
 
    x = 4
    For i = 0 To Me.lst2.ListCount - 1
        For j = 0 To 4
            With Sheet6
                .Cells(x, j + 9) = lst2.List(i, j)
            End With
        Next
        x = x + 1
    Next
    Unload Me
End If
 
End Sub
 
Private Sub lst3_Click()
 
If Me.lst2.ListIndex <> -1 Then Me.lst2.Selected(Me.lst2.ListIndex) = False
 
End Sub
 
Private Sub lst2_Click()
 
If Me.lst3.ListIndex <> -1 Then Me.lst3.Selected(Me.lst3.ListIndex) = False
 
End Sub
 
Private Sub txtFilter_Change()
 
Dim db As Variant
Dim i As Long: Dim j As Long
ReDim db(0 To lst1.ListCount - 1, 0 To 4)
 
For i = 0 To Me.lst1.ListCount - 1
    For j = 0 To 4
        db(i, j) = Me.lst1.List(i, j)
    Next
Next
 
db = Filtered_DB(db, Me.txtFilter.Value)
 
Me.lst3.Clear
If Not IsEmpty(db) Then Me.lst3.List = db
 
End Sub
 
Private Sub UserForm_Initialize()
 
Dim rng As Range
Dim db As Variant
 
With Sheet6
    Set rng = .Range(.Cells(4, 3), .Cells(.Cells(.Rows.Count, 3).End(xlUp).Row, 8))
End With
 
db = rng
 
With Me.lst1
    .ColumnCount = 5
    .ColumnWidths = "0pt;70pt;60pt;60pt;50pt"
    .List = db
End With
 
With Me.lst3
    .ColumnCount = 5
    .ColumnWidths = "0pt;70pt;60pt;60pt;50pt"
    .List = db
End With
 
With Me.lst2
    .ColumnCount = 5
    .ColumnWidths = "0pt;70pt;60pt;60pt;50pt"
End With
 
End Sub
 
Function Get_ListRecord(db, ListIndex, Value) As Long
 
Dim i As Long
 
For i = LBound(db, 1) To UBound(db, 1)
    If db(i, ListIndex) = Value Then Get_ListRecord = i: Exit Function
Next
 
End Function
Function Filtered_DB(db, Value, Optional ExactMatch As Boolean = False) As Variant
 
Dim cRow As Long
Dim cCol As Long
Dim vArr As Variant: Dim s As String
Dim vReturn As Variant: Dim vResult As Variant
Dim Dict As Dictionary: Dim dictKey As Variant
Dim i As Long: Dim j As Long: Dim x As Long
 
Set Dict = New Dictionary
 
If Value <> "" Then
    cRow = UBound(db, 1)
    cCol = UBound(db, 2)
    ReDim vArr(LBound(db, 1) To cRow)
    For i = LBound(db, 1) To cRow
        s = ""
        For j = LBound(db, 2) To cCol
            s = s & db(i, j) & "|^"
        Next
        vArr(i) = s
    Next
 
    If ExactMatch = False Then
        For i = LBound(db, 1) To cRow
            If InStr(1, vArr(i), Value) > 0 Then
                vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                vReturn = Split(vArr(i), "|^")
                Dict.Add i, vReturn
            End If
        Next
    Else
        For i = LBound(db, 1) To cRow
            If vArr(i) = Value & "|^" Then
                vArr(i) = Left(vArr(i), Len(vArr(i)) - 2)
                vReturn = Split(vArr(i), "|^")
                Dict.Add i, vReturn
            End If
        Next
    End If
 
    If Dict.Count > 0 Then
        ReDim vResult(LBound(db, 1) To Dict.Count, LBound(db, 2) To cCol)
        i = LBound(db, 1)
        For Each dictKey In Dict.Keys
            x = 0
            For j = LBound(db, 2) To cCol
                vResult(i, j) = Dict(dictKey)(x)
                x = x + 1
            Next
            i = i + 1
        Next
    End If
 
    Filtered_DB = vResult
Else
    Filtered_DB = db
End If
 
End Function
 
'커서 이동시 버튼 색깔을 변경하는 보조명령문을 유저폼에 추가합니다.
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
 
'유저폼에 추가한 버튼에 개수만큼 아래 명령문을 유저폼에 추가한 뒤, btnAdd를 버튼 이름으로 변경합니다.
Private Sub btnAdd_Exit(ByVal Cancel As MSForms.ReturnBoolean)
OutHover_Css Me.btnAdd
End Sub
 
Private Sub btnAdd_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
OnHover_Css Me.btnAdd
End Sub
 
'유저폼에 추가한 버튼에 개수만큼 아래 명령문을 유저폼에 추가한 뒤, btnRemove를 버튼 이름으로 변경합니다.
Private Sub btnRemove_Exit(ByVal Cancel As MSForms.ReturnBoolean)
OutHover_Css Me.btnRemove
End Sub
 
Private Sub btnRemove_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
OnHover_Css Me.btnRemove
End Sub
 
'유저폼에 추가한 버튼에 개수만큼 아래 명령문을 유저폼에 추가한 뒤, btnSubmit를 버튼 이름으로 변경합니다.
Private Sub btnSubmit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
OutHover_Css Me.btnSubmit
End Sub
 
Private Sub btnSubmit_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
OnHover_Css Me.btnSubmit
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 = "btnAdd, btnRemove, btnSubmit" ' 버튼 이름을 쉼표로 구분하여 입력하세요.
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