👾nanani | 掲示板・QAサイトリリース👾

「Excel – VBA」セルの位置を取得して一覧をメッセージボックス表示したい

こんにちは👾

佐川急便のe飛伝2がe飛伝3へ移行するにあたり、使い辛いとの声をよく耳にします

これを機に
csvインポートに切り替えたいけど、入力ミスが多発してしまう

と。

こういった入力業務はITを利用して、誰が使ってもミス防止できて、効率化できて、高品質化できる3拍子そろった業務ツールを都度作ってあげることが必要です

入力規則設定した入力フォームを作れる方が不在だと、そもそも厳しい話ではございますが

Excelファイルの前提

Sheet:[送り状発行]

A列:[郵便番号]

B列:[住所]

入力規則都度判定 – メッセージボックス表示

VBAProjectを「Alt+F11」で開きます
該当のSheetへ以下を入力してください

Private Sub Worksheet_Change(ByVal Target As Range)

Dim 郵便番号 As Range
Set 郵便番号 = Intersect(Columns("A"), Target)

Dim 住所 As Range
Set 住所 = Intersect(Columns("B"), Target)

If Not 郵便番号 Is Nothing Then
If 郵便番号.Value = "" Then '空白時は無視
Exit Sub
郵便番号.Value = Replace(Replace(郵便番号.Value, "-", ""), "ー", "") 'ハイフン消し
End If
If 郵便番号.Value <> "郵便番号" Then '本番時は桁数や数値を判定してください
郵便番号.Select
MsgBox "郵便番号を入力してください" & vbCrLf & "OKを押すと値をクリアします", vbExclamation
郵便番号.ClearContents
End If
End If

If Not 住所 Is Nothing Then
If 住所.Value = "" Then '空白時は無視
Exit Sub
ElseIf 住所.Value <> "住所" Then '本番時は桁数などを判定してください
住所.Select
MsgBox "住所を入力してください" & vbCrLf & "OKを押すと値をクリアします", vbExclamation
住所.ClearContents
End If
End If

End Sub
セル位置情報取得 – メッセージボックス方法

上記のMsgBox箇所を書きかえてください

MsgBox "セル位置【 " & 郵便番号.Address(False, False) & " 】: 郵便番号を入力してください" & vbCrLf & "OKを押すと値をクリアします", vbExclamation
MsgBox "セル位置【 " & 住所.Address(False, False) & " 】: 住所を入力してください" & vbCrLf & "OKを押すと値をクリアします", vbExclamation
一括判定 – メッセージボックスへ一覧表示

VBAProjectを「Alt+F11」で開きます
該当のSheetへ以下を入力してください
※ユーザーフォーム(UserForm1)は別途作成してください

メッセージボックスではなくユーザーフォームに変更してます
※メッセージ表示したまま確認し修正できるようにする為

Sub 一括判定()

UserForm1.Hide
Worksheets("送り状発行").Range("A:B").Interior.ColorIndex = xlNone

Dim MSG As String
MSG = ""
Dim 最終行 As Long, i As Long
Application.ScreenUpdating = False '画面ちらつき制御

最終行 = Worksheets("送り状発行").Cells(Rows.Count, 2).End(xlUp).Row '住所最終行を取得

For i = 2 To 最終行 '1行目は表題行のため2行目から

Worksheets("送り状発行").Cells(i, 1).Value = Replace(Replace(Worksheets("送り状発行").Cells(i, 1).Value, "-", ""), "ー", "") 'ハイフン消し

If Worksheets("送り状発行").Cells(i, 1).Value <> "郵便番号" And Worksheets("送り状発行").Cells(i, 1).Value <> "" Then
MSG = MSG & "セル位置【 " & Worksheets("送り状発行").Cells(i, 1).Address(False, False) & " 】: 郵便番号を入力してください" & vbCrLf
Worksheets("送り状発行").Cells(i, 1).Interior.Color = RGB(248, 203, 173)
End If
    
If Worksheets("送り状発行").Cells(i, 2).Value <> "住所" And Worksheets("送り状発行").Cells(i, 2).Value <> "" Then
MSG = MSG & "セル位置【 " & Worksheets("送り状発行").Cells(i, 2).Address(False, False) & " 】: 住所を入力してください" & vbCrLf
Worksheets("送り状発行").Cells(i, 2).Interior.Color = RGB(248, 203, 173)
End If
    
Next

If MSG = "" Then
Exit Sub
Else: UserForm1.TextBox1.Value = MSG
UserForm1.Show (vbModeless)
End If

End Sub

実際はもっとガチガチに様々条件を設定していくことになりますが、今回は一部を載せました

コードの共有が初めてで、”わかり辛い” かつ “説明不足” は否めません
※コード共有サイトはセキュティの観点で使用しておりません。外部サイト通信してませんのでご安心ください

申し訳ないです

この記事が気に入ったら
フォローしてね!

  • URLをコピーしました!
  • URLをコピーしました!

この記事を書いた人

BOOGALOO BOOGALOO ブガルー代表

掲示板サイトの nanini を
全力で開発いたしております👾
どうしてもみんなの憩いの場が作りたい

目次
閉じる