「Excel – VBA」可視セルへナンバリング

2022年3月19日2024年1月29日

こんにちは

ECサイトの倉庫ピッキング、PCキッティングなどの案件では如何に機械的に効率化、ミス防止、コスト削減するのかが基本中の基本だと存じます

スキームに沿ってフローを確立し、最後に業務ツールを整備します

誰が作業員であっても高品質の作業になるようインフラ整備するのが管理者の務めです

様々な言語がございますが、ほとんどの会社、個人PCにもMicrosoft Officeが入っているので、選択肢は1つだけMicrosoftです

本当、Microsoftの1強ですよね、直感的に操作できる便利簡単

他のシステムだとレポートを先方に送った時に別途プログラムインストールしないと見れないなど迷惑です

AccessかExcelを使うことが多いかと存じますが、生成データがcsvだけだと分かりづらいので、結局レポート作る時にExcelピボットテーブルなどで見た目を整えますから私は最初からExcelを使います

作業者に操作させる時は、データを直接さわらせません、テーブルを隠してユーザーフォームだけを入力してもらいます

Microsoft Officeはシェア世界一なので調べればいくらでも情報はみつけられますし、誰でもマクロツールは作れます。仕事の目的、背景を理解することが重要なので新卒の方にむけて長々と前置きいたしましたごめんなさい

ついでにVBAを少し記載

ユーザーフォームは省きますが、組み合わせて、もしくはロジックをヒントに閃きにつなげてください

例えばこんな感じの在庫リスト。入力漏れなのかどうか、操作ミスで消してしまったのかわからないので、ブランクではなくハイフンでデータを持つようにしましょう。

A列：在庫ロケーション

B列：在庫商品名/型番など

C列：納品先/送り状など

D列：ピックアップセット(ナンバリング箇所)

在庫昇順でピックアップする処理のユーザーフォームがあり、注文情報を入力してC列に納品先が入力された状態を想定しております。

C列で今回の納品先にフィルタリングされた状態です。

実際はユーザーフォーム制御しますが、今回はD列を範囲選択した状態でマクロ実行するよう作りました。

選択範囲内で処理が行われます。

実行後の状態です。可視セルにのみ処理を行われていることがポイントです

変数名は意味のないアルファベットを使用しております

Sub ナンバリンング()

Dim 在庫数 As Integer
Dim HitValue() As Variant
Dim D As Long
Dim M As Integer
Dim V As String
Dim RR As String

M = 1

If Selection.Column <> 4 Then
MsgBox "納品パッキング列を選択してください": Exit Sub
End If

If Selection.Count = 1 Then
D = Selection.ROW
Cells(D, 4).Value = Cells(D, 3).Value & "_" & Format(M, "000")
Exit Sub
End If

Set 範囲 = Selection.SpecialCells(xlCellTypeVisible)

在庫数 = 範囲.Count
ReDim HitValue(1 To (在庫数), 1)

n = 1
For Each セル In 範囲
For Each 抽出 In セル.Areas
HitValue(n, 0) = 抽出.ROW
HitValue(n, 1) = Cells(抽出.ROW, 2).Value
n = n + 1
Next
Next

For I = 1 To 在庫数
If V <> Cells(HitValue(I, 0), 3).Value Then
M = 1
End If
Cells(HitValue(I, 0), 4).Value = Cells(HitValue(I, 0), 3).Value & "_" & Format(M, "000")
M = M + 1
V = Cells(HitValue(I, 0), 3).Value
Next

For Each セル In 範囲
If 在庫数 = 1 Then
Exit For
End If
If WorksheetFunction.Subtotal(3, 範囲, セル) > 1 Then
If セル.Offset(0, -1).Value = RR Then
GoTo SSS
End If

RR = セル.Offset(0, -1).Value
Sheets("リスト").Range("A:AU").AutoFilter Field:=3, Criteria1:=Array( _
セル.Offset(0, -1).Value), Operator:=xlFilterValues
Set NEW範囲 = Selection.SpecialCells(xlCellTypeVisible)
NEW在庫数 = NEW範囲.Count
ReDim HitValue(1 To (NEW在庫数), 1)
n = 1
For Each NEWセル In NEW範囲
For Each NEW抽出 In NEWセル.Areas
HitValue(n, 0) = NEW抽出.ROW
HitValue(n, 1) = Cells(NEW抽出.ROW, 2).Value
n = n + 1
Next
Next

M = 1
For I = 1 To NEW在庫数
Cells(HitValue(I, 0), 4).Value = Cells(HitValue(I, 0), 3).Value & "_" & Format(M, "000")
M = M + 1
Next
Sheets("リスト").Range("A:AD").AutoFilter Field:=3
Else: Exit Sub
End If

SSS:
Next セル

End Sub

シート名は「リスト」です