タグ: Excel2016

Excelで実地棚卸を管理するプログラムを作成します。

PhysicalInventory.zip

1 file(s) 21.89 KB

エクセルファイルをダウンロード

このエクセルファイルの作り方

①マクロを使えるようにする
「マクロを使えるようにする」を参照

②実地棚卸の表を作成

③ 「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