投稿日:

【Excel】Excelで実地棚卸

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

Icon

PhysicalInventory.zip

1 file(s) 21.89 KB
エクセルファイルをダウンロード

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

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

②実地棚卸の表を作成

③ 「Alt + F8」を押して表示される以下の画面で「マクロ名」を「SearchGoods_InputInventoryQuantity」として「作成」を押す

④ Microsoft Visual Basic for Applications」にて以下のコードを記載

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
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