「Excel – VBA」可視セルへナンバリング
こんにちは👾
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シート名は「リスト」です
作業ラインを効率化したい、作業ラインを立ち上げてフローの作成から業務ツール導入をお願いしたいなど、お問い合わせください
キックオフから常駐し作業ラインを立ち上げ、3カ月程度で運用安定したら業務ツールの保守のみ承る、もしくは業務ツールも全て売り切りで編集できる状態でお渡しするプランもございます
保守契約の場合は機能追加など柔軟に対応いたしますが、お客様にカスタムされますと修正が困難なのでVBA編集はロックさせていただきます
作業ラインを運用センターごとアウトソーシング(丸投げ)することも可能です
業務ツールだけ制作するご依頼が最もフットワーク軽いです、無料ヒアリングに伺いますのでお気軽にご相談ください
ご連絡おまちいたしております
この記事が気に入ったら
フォローしてね！
