Excelで実地棚卸を管理するプログラムを作成します。
PhysicalInventory.zip
このエクセルファイルの作り方
①マクロを使えるようにする
「マクロを使えるようにする」を参照
②実地棚卸の表を作成
③ 「Alt + F8」を押して表示される以下の画面で「マクロ名」を「SearchGoods_InputInventoryQuantity」として「作成」を押す
④ Microsoft Visual Basic for Applications」にて以下のコードを記載
Public enterFlg As Boolean Sub SearchGoods_InputInventoryQuantity() '検索文字入力行・列 Dim searchValueRow As Integer: searchValueRow = 1 '★ Dim searchValueCol As Integer: searchValueCol = 2 '★ '検索対象列 Dim searchTargetCol As Integer: searchTargetCol = 2 '★ '検索文字' Dim searchValue As String: searchValue = Cells(searchValueRow, searchValueCol).Value '棚卸数量入力行・列 Dim inventoryQuantityRow As Integer: inventoryQuantityRow = 2 '★ Dim inventoryQuantityCol As Integer: inventoryQuantityCol = 2 '★ '棚卸数量転記対象列 Dim copyQuantityTargetCol As Integer: copyQuantityTargetCol = 8 '★ '商品コード未入力メッセージ' Dim codeNotEnteredMessage As String: codeNotEnteredMessage = "商品コードを入力してください" '★ '重複メッセージ' Dim duplicateMessage As String: duplicateMessage = "既に入力があります" '★ '開始行 Dim startRow As Integer: startRow = 5 '★ '終了行 Dim lastRow As Integer: lastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 'アクティブCellが商品コードまたは棚卸数量欄でなければアクティブセルの移動のみ Dim activeRow As Integer: activeRow = ActiveCell.Row Dim activeCol As Integer: activeCol = ActiveCell.Column '商品コード検索 If activeRow = searchValueRow And activeCol = searchValueCol Then For i = startRow To lastRow Step 1 If Cells(i, searchTargetCol).Value <> searchValue And searchValue <> "" Then Rows(i).Hidden = True Else Rows(i).Hidden = False End If Next Cells(activeRow + 1, activeCol).Select '棚卸数量入力(1回目) ElseIf activeRow = inventoryQuantityRow And activeCol = inventoryQuantityCol And enterFlg = False And Cells(inventoryQuantityRow, inventoryQuantityCol) <> "" Then If Cells(searchValueRow, searchValueCol).Value = "" Then MsgBox codeNotEnteredMessage Cells(searchValueRow, searchValueCol).Select Exit Sub End If For i = startRow To lastRow Step 1 If Cells(i, copyQuantityTargetCol).Value = "" And Rows(i).Hidden = False Then Cells(i, copyQuantityTargetCol).Value = Cells(inventoryQuantityRow, inventoryQuantityCol) ElseIf Cells(i, copyQuantityTargetCol).Value <> "" And Rows(i).Hidden = False Then MsgBox duplicateMessage Exit Sub End If Next enterFlg = True '棚卸数量入力(2回目) ElseIf activeRow = inventoryQuantityRow And activeCol = inventoryQuantityCol Then For i = startRow To lastRow Step 1 Rows(i).Hidden = False Next Cells(inventoryQuantityRow, inventoryQuantityCol) = "" Cells(searchValueRow, searchValueCol).Select enterFlg = False Else Cells(activeRow + 1, activeCol).Select Exit Sub End If End Sub Sub Auto_Open() '「実地棚卸」シートがアクティブになったら「AutoActivateSheet_Name」マクロ実行 Worksheets("実地棚卸").OnSheetActivate = "AutoActivateSheet_Name" '「実地棚卸」シート以外がアクティブになったら「AutoDeactivateSheet_Name」マクロ実行 Worksheets("実地棚卸").OnSheetDeactivate = "AutoDeactivateSheet_Name" End Sub Sub AutoActivateSheet_Name() 'Enterを押すと「SearchGoods_InputInventoryQuantity」マクロ実行 Application.OnKey "~", "SearchGoods_InputInventoryQuantity" Application.OnKey "{Enter}", "SearchGoods_InputInventoryQuantity" End Sub Sub AutoDeactivateSheet_Name() 'テンキーのEnterへの割り当て解除 Application.OnKey "{Enter}" '大きいEnterへの割り当て解除 Application.OnKey "~" End Sub