前提・実現したいこと

ExcelVBAで申請書をテキスト出力するツールを使用しています。
そのツールに２つ機能を追加しようとしています。

①申請書には申請区分が１～３まであり、それぞれの区分に応じた必須入力項目に値が入っていなければ（セルが空白の時）エラーメッセージを出力する。その時に、未入力のセルの場所も表示させる。
エラーメッセージ例)
A5,E3,G12 セルに入力してください。

②申請区分を選択した際、必須入力項目のセル色を変更
申請区分１～３で登場する全ての必須項目のうち、申請区分を１を選んだ場合は、全体の必須項目から申請区分１の必須項目のみをRGB(255,255,153)に、それ以外の申請区分２、３の必須項目でかつ申請区分１で使用しないものは、RGB(255,255,255)というようにしたいです。

※申請区分はC3セルで、申請区分1～3までをプルダウンで選択する仕様です。
各申請区分の必須項目
・申請区分１（D3,D4,D5,D6,D9,D12,E22,F22,D25,D28）
・申請区分２（D5,D6,D11,D16,E34,F34,D36,D37）
・申請区分３（D5,D6,D15,D16,E18,E19,D25,E35,D36）

今後申請区分が増えるため、簡潔に配列を使用した処理で書きたいと思っております。
①についてはセルの配列処理が上手くできず、止まっています。
配列を使用せず、必須項目のいずれかが空白だった場合にエラーを出力することはできるのですが、そこから先が出来ずにいます。
②は処理はできるのですが、長くなってしまいます。

配列はあまり使用した事がないのですが、今回使用してプログラムを書いてみようと思いました。

発生している問題・エラーメッセージ

1.セルの配列処理をどのようにしたらよいのか分かりません。
セルの値を取得することはできるのですが、セルの場所の表示方法が分かりません。
また、必須項目のうち空白セルの場所だけを組み合わせて表示するにはどのようにしたらよいのでしょうか。
2.必須項目のセルの色の変更も配列で行いたいのですが、現状だと長くなってしまうので、改善したいと考えています。

該当のソースコード

VBA
1Sub input_check()
2'①セルの入力チェック
3
4    If Range("C3") = "申請区分1" Then
5        If Range("D3") = "" Or Range("D4") = "" Or Range("D5") = "" Or Range("D6") = "" Or Range("D9") = "" Or Range("D12") = "" _
6            Or Range("E22") = "" Or Range("F22") = "" Or Range("D25") = "" Or Range("D28") = "" Then
7            MsgBox "未入力セルがあります"
8        End If
9
10    ElseIf Range("C3") = "申請区分2" Then
11        If Range("D5") = "" Or Range("D6") = "" Or Range("D11") = "" Or Range("D16") = "" Or Range("E34") = "" Or Range("F34") = "" _
12            Or Range("D36") = "" Or Range("D37") = "" Then
13            MsgBox "未入力セルがあります"
14        End If
15
16    ElseIf Range("C3") = "申請区分3" Then
17        If Range("D5") = "" Or Range("D6") = "" Or Range("D15") = "" Or Range("D16") = "" Or Range("E18") = "" Or Range("E19") = "" _
18            Or Range("D25") = "" Or Range("E35") = "" Or Range("D36") = "" Then
19            MsgBox "未入力セルがあります"
20        End If
21    
22    End If
23
24End Sub

該当のソースコード

VBA
1Sub sinsei()
2
3'②必須項目セルの色を変更
4
5If Range("C3") = "申請区分1" Then
6   '申請区分1の必須項目を黄色に
7    Range("D3").Interior.Color = RGB(255, 255, 153)
8    Range("D4").Interior.Color = RGB(255, 255, 153)
9    Range("D5").Interior.Color = RGB(255, 255, 153)
10    Range("D6").Interior.Color = RGB(255, 255, 153)
11    Range("D9").Interior.Color = RGB(255, 255, 153)
12    Range("D12").Interior.Color = RGB(255, 255, 153)
13    Range("E22").Interior.Color = RGB(255, 255, 153)
14    Range("F22").Interior.Color = RGB(255, 255, 153)
15    Range("D25").Interior.Color = RGB(255, 255, 153)
16    Range("D28").Interior.Color = RGB(255, 255, 153)
17     
18   '申請区分2の必須項目を白色に（申請区分1と共通の項目は除く）
19    Range("D11").Interior.Color = RGB(255, 255, 255)
20    Range("D16").Interior.Color = RGB(255, 255, 255)
21    Range("E34").Interior.Color = RGB(255, 255, 255)
22    Range("F34").Interior.Color = RGB(255, 255, 255)
23    Range("D36").Interior.Color = RGB(255, 255, 255)
24    Range("D37").Interior.Color = RGB(255, 255, 255)
25
26   '申請区分3の必須項目を白色に（申請区分1,申請区分2と共通の項目は除く）
27    Range("D15").Interior.Color = RGB(255, 255, 255)
28    Range("E18").Interior.Color = RGB(255, 255, 255)
29    Range("E19").Interior.Color = RGB(255, 255, 255)
30    Range("D25").Interior.Color = RGB(255, 255, 255)
31    Range("E35").Interior.Color = RGB(255, 255, 255)
32   
33ElseIf Range("C3") = "申請区分2" Then
34    '申請区分2の必須項目を黄色に
35    Range("D5").Interior.Color = RGB(255, 255, 153)
36    Range("D6").Interior.Color = RGB(255, 255, 153)
37    Range("D11").Interior.Color = RGB(255, 255, 153)
38    Range("D16").Interior.Color = RGB(255, 255, 153)
39    Range("E34").Interior.Color = RGB(255, 255, 153)
40    Range("F34").Interior.Color = RGB(255, 255, 153)
41    Range("D36").Interior.Color = RGB(255, 255, 153)
42    Range("D37").Interior.Color = RGB(255, 255, 153)
43
44    '申請区分1の必須項目を白色に（申請区分2と共通の項目は除く）
45    Range("D3").Interior.Color = RGB(255, 255, 255)
46    Range("D4").Interior.Color = RGB(255, 255, 255)
47    Range("D9").Interior.Color = RGB(255, 255, 255)
48    Range("D12").Interior.Color = RGB(255, 255, 255)
49    Range("E22").Interior.Color = RGB(255, 255, 255)
50    Range("F22").Interior.Color = RGB(255, 255, 255)
51    Range("D25").Interior.Color = RGB(255, 255, 255)
52    Range("D28").Interior.Color = RGB(255, 255, 255)
53
54    '申請区分3の必須項目を白色に（申請区分1,申請区分2と共通の項目は除く）
55    Range("D15").Interior.Color = RGB(255, 255, 255)
56    Range("E18").Interior.Color = RGB(255, 255, 255)
57    Range("E19").Interior.Color = RGB(255, 255, 255)
58    Range("D25").Interior.Color = RGB(255, 255, 255)
59    Range("E35").Interior.Color = RGB(255, 255, 255)
60
61ElseIf Range("C3") = "申請区分3" Then
62    '申請区分3の必須項目を黄色に
63    Range("D5").Interior.Color = RGB(255, 255, 153)
64    Range("D6").Interior.Color = RGB(255, 255, 153)
65    Range("D15").Interior.Color = RGB(255, 255, 153)
66    Range("D16").Interior.Color = RGB(255, 255, 153)
67    Range("E18").Interior.Color = RGB(255, 255, 153)
68    Range("E19").Interior.Color = RGB(255, 255, 153)
69    Range("D25").Interior.Color = RGB(255, 255, 153)
70    Range("E35").Interior.Color = RGB(255, 255, 153)
71    Range("D36").Interior.Color = RGB(255, 255, 153)
72    
73    '申請区分1の必須項目を白色に（申請区分3と共通の項目は除く）
74    Range("D3").Interior.Color = RGB(255, 255, 255)
75    Range("D4").Interior.Color = RGB(255, 255, 255)
76    Range("D9").Interior.Color = RGB(255, 255, 255)
77    Range("D12").Interior.Color = RGB(255, 255, 255)
78    Range("E22").Interior.Color = RGB(255, 255, 255)
79    Range("F22").Interior.Color = RGB(255, 255, 255)
80    Range("D25").Interior.Color = RGB(255, 255, 255)
81    Range("D28").Interior.Color = RGB(255, 255, 255)
82    
83    '申請区分2の必須項目を白色に（申請区分1,申請区分3と共通の項目は除く）
84    Range("D11").Interior.Color = RGB(255, 255, 255)
85    Range("E34").Interior.Color = RGB(255, 255, 255)
86    Range("F34").Interior.Color = RGB(255, 255, 255)
87    Range("D37").Interior.Color = RGB(255, 255, 255)
88
89End If
90
91End Sub
92

試したこと

VBA
1Sub array_test()
2'セルの値の取得（OK）
3Dim ary(3) As String
4ary(0) = Cells(3, 1)
5
6MsgBox ary(0)
7
8End Sub
9
10Sub array_test2()
11'セルの場所の取得（実行時エラー91）
12Dim ary(3) As Range
13ary(0) = Cells(3, 1)
14            
15MsgBox ary(0)
16
17End Sub
18

ご存知の方おりましたら、教えて頂けますと幸いです。
よろしくお願い致します。

行動規範の内容に同意します

回答5件

ベストアンサー

文字列で定義しておいて、Splitで配列化するとメンテが楽だと思います。
また、色設定のときのRangeにもそのまま使えます。

Const 申請区分1用 As String = "D3,D4,D5,D6,D9,D12,E22,F22,D25,D28"
Const 申請区分2用 As String = "D5,D6,D11,D16,E34,F34,D36,D37"
Const 申請区分3用 As String = "D5,D6,D15,D16,E18,E19,D25,E35,D36"
'
' jawaさんのご指摘により修正。
' クリア用には色をつけるセル。つまりを申請区分1用～申請区分3用のセルをすべて
' 含める必要があります。この際、漏れが発生しやすいため以下のとおり修正
'
' Const クリア用 As String =
'  "D3,D4,D5,D6,D9,D12,E22,F22,D25,D28,D11,D16,E34,F34,D36,D37,D15,E18,E19,E35,D36"
Dim クリア用 As String: クリア用 = 申請区分1用 & "," & 申請区分2用 & "," & 申請区分3用

Dim txt As String
If (Range("C3") = "申請区分1") Then
  txt = 申請区分1用
ElseIf (Range("C3") = "申請区分2") Then
  txt = 申請区分2用
ElseIf (Range("C3") = "申請区分3") Then
  txt = 申請区分3用
End If

Dim adrs As Variant: adrs = Split(txt, ",")                 ' 配列化
Dim ix As Long

' ここから置き換え--------------------------------------------------
txt = ""
For ix = 0 To UBound(adrs)
  If (Me.Range(adrs(ix)) = "") Then txt = txt & "," & adrs(ix)       ' アドレスを収集
Next ix
If (txt <> "") Then
  '
  ' アドレスはtxtに収集されています
  '
  txt = Mid$(txt, 2)                                              ' txt先頭の","を除去
  MsgBox ("未入力セルがあります") & vbCrLf & "(""" & txt & "'')"    ' メッセージ
  Range(クリア用).Interior.Color = RGB(255, 255, 255)              ' 全クリア
  Range(txt).Interior.Color = RGB(255, 255, 153)                  ' 空白セルだけ色をつける
End If
' ここまで --------------------------------------------------------  

' 旧コード --------------------------------------------------------
'For ix = 0 To UBound(adrs)
'  If (Range(adrs(ix)) = "") Then Exit For
'Next ix
'If (ix <= UBound(adrs)) Then
'  MsgBox ("未入力セルがあります")
'  Range(クリア用).Interior.Color = RGB(255, 255, 255)
'  Range(txt).Interior.Color = RGB(255, 255, 153)
'End If

投稿2018/09/18 01:07

編集2018/09/19 03:39

h.horikoshi

総合スコア505

jawa

2018/09/18 11:28

私も実装するとしたらこの方法かな、と思いました。 ②の色付けだけなら条件付き書式(=$C$1="申請区分1"など)ですむのですが、どのみちVBAで対象セルを管理して入力チェックを行うということですので、この方法が管理しやすいかと思います。クリアまで配慮されているところがh.horikoshiさんのやさしさですね。クリア用配列にはこの処理で色がつく可能性があるセルすべてを列記する必要があります（つまりすべての配列の要素の集合となる）ので、申請区分を追加される場合にはメンテ漏れにご注意ください。

h.horikoshi

2018/09/19 00:15

>jawaさんコメントありがとうございます。 >クリア用配列にはこの処理で色がつく可能性があるセルすべてを列記する必要がありますはい。これでは、あまり"メンテが楽"ではない(というかご指摘のように漏れが起きやすい)ですね(笑)。あとで考えたのですが、クリア用 = 申請区分1用 & "," & 申請区分2用 & "," & 申請区分3用としてしまえば、少しは楽になるかなと思います。セルの重複があるので実行効率は悪いですが。

退会済みユーザー

2018/09/19 00:30

ご回答ありがとうございます。色設定や、メンテナンス面も考慮されていて、非常に参考になりました。

退会済みユーザー

2018/09/19 03:02

MsgBox ("未入力セルがあります")&vbCrlf&("D5,D12")というような感じで、MsgBox ("未入力セルがあります")と一緒に、空白セルの場所を表示する事は出来ますでしょうか。

h.horikoshi

2018/09/19 03:40

>空白セルの場所を表示する事は出来ますでしょうか。 - 最初の空白セルだけでなく、すべての空白セルを表示するにはループを途中でexitせず、最後までまわしてください。 - エラーを検出したセルアドレスはadrs(ix) で得られますので、これを収集していきます。 - あと、すいません、色を変えるのは空白セルだけですね。回答のコードを修正しましたのでご確認ください。

退会済みユーザー

2018/09/20 05:03

ご丁寧にありがとうございます。非常に助かります。何とか無事に出来ました。

行動規範の内容に同意します

「試したこと」のエラーについて

vba
1'セルの値の取得（OK）
2Dim ary(3) As String
3ary(0) = Cells(3, 1)

このコードですが、実際はCellsの後ろの.Value（のようなもの）が省略されています。
省略せずに書くと以下のようになります。

vba
1'セルの値の取得（OK）
2Dim ary(3) As String
3ary(0) = Cells(3, 1).Value

（アクティブなシートの）セル全体の、3行目1列目のセル（Range）について
値（Variant型）を取得し、それを文字列に変換して、ary(0)へ代入します。

Cells(3, 1)とRangeを指定したのに、なぜValueが出てくるかというと
VBAでは、「オブジェクト（Rangeなど）の代入にはSetを付ける」というルールがあるため、
Setが付いていない→何かしらの値の代入と判断→Valueが自動補完される、ということになります。

これを踏まえてarray_test2の記述を見てみます。

vba
1'セルの場所の取得（実行時エラー91）
2Dim ary(3) As Range
3ary(0) = Cells(3, 1)

ary(0) = Cells(3, 1)の文ですが、Setが付いていないため値の代入と判断されます。
しかしary(0)は中身がない（Nothing）、つまりオブジェクト変数の中身が設定されていないため
オブジェクト変数または With ブロック変数が設定されていません。
のエラーが発生します。

各申請区分の範囲は、名前付き範囲にしておくと設定範囲がわかりやすくなると思います。

また今回の場合であれば、配列にこだわらず、Rangeの機能を使うのも手ではないかと思います。

h.horikoshiさんのコードをベースにRangeの機能を活用すると以下のような感じでしょうか。

vba
1Option Explicit
2
3Private Const 申請区分1用 As String = "D3,D4,D5,D6,D9,D12,E22,F22,D25,D28"
4Private Const 申請区分2用 As String = "D5,D6,D11,D16,E34,F34,D36,D37"
5Private Const 申請区分3用 As String = "D5,D6,D15,D16,E18,E19,D25,E35,D36"
6
7'申請区分の必須セルを取得する関数
8Private Function getRequestClassRequireCells() As Excel.Range
9    'TODO:シート指定
10    Dim ws As Excel.Worksheet
11    Set ws = ActiveSheet 'ThisWorkbook.Worksheets.Item(シートの名前)
12    
13    Select Case ws.Range("C3").Text
14        Case "申請区分1"
15            Set getRequestClassRequireCells = ws.Range(申請区分1用)
16        Case "申請区分2"
17            Set getRequestClassRequireCells = ws.Range(申請区分2用)
18        Case "申請区分3"
19            Set getRequestClassRequireCells = ws.Range(申請区分3用)
20        Case Else
21            Err.Raise 5, Description:="申請区分に不適切な値が指定されています。"
22    End Select
23End Function
24
25Sub input_check()
26    
27    '未入力のセル
28    Dim emptyCells As Excel.Range
29    
30    '申請区分の必須セルそれぞれの中身を確認
31    Dim r As Excel.Range
32    For Each r In getRequestClassRequireCells()
33        If r.Text = VBA.vbNullString Then
34            '空なら結合
35            Set emptyCells = Union2(emptyCells, r)
36        End If
37    Next r
38    
39    '空のものがない＝入力OK
40    If emptyCells Is Nothing Then
41        Exit Sub
42    End If
43    
44    Dim msg As String
45    msg = "未入力セルがあります。" & vbLf & _
46          emptyCells.AddressLocal(False, False) 'Range.Addressでセル番地取得
47    
48    Call VBA.MsgBox(msg)
49End Sub
50
51Sub sinsei()
52    '全部白にしてから黄色にする
53    Call Clear
54    getRequestClassRequireCells().Interior.Color = RGB(255, 255, 153)
55End Sub
56
57Private Sub Clear()
58    '対象セル全結合して背景白
59    'TODO:シート指定
60    Excel.Union(Range(申請区分1用), Range(申請区分2用), Range(申請区分3用)).Interior.Color = vbWhite
61End Sub
62
63'Nothingを許容するUnion
64Private Function Union2(a As Excel.Range, b As Excel.Range) As Excel.Range 'Or Nothing
65    If a Is Nothing Then
66        Set Union2 = b
67        Exit Function
68    End If
69    
70    If b Is Nothing Then
71        Set Union2 = a
72    Else
73        Set Union2 = a.Application.Union(a, b)
74    End If
75End Function

投稿2018/09/18 14:37

imihito

総合スコア2166

退会済みユーザー

2018/09/18 23:59

非常に分かりやすいご説明ありがとうございます。根本的なところを理解出来き、大変勉強になりました。

行動規範の内容に同意します

折角エクセルを使ってるんですから、
シートに表形式で判定一覧を作ってはどうでしょうか？
(自分はよくやる方法です)

CDEにエラーチェックフラグを立てておき、
チェック対象なら、該当アドレスのセルに対して、
該当のエラーチェックを実施する、
という処理を回すだけですみます。

投稿2018/09/18 03:33

ExcelVBAer

総合スコア1175

退会済みユーザー

2018/09/19 00:02

ご回答ありがとうございます。エクセルを使って、エラーフラグを立てる方法があるとは知りませんでした。大変参考になりました。

ExcelVBAer

2018/09/19 00:18

この方法のメリットは、メンテのしやすさにあります。アドレス欄には、=Address(Row([対象セル]),Column([対象セル])) と数式で設定しておきます。エラーフラグも、数式を使えば条件によって変化させられます。申請区分の増加・削除、エラーの追加・削除はもとより、対象セルの移動等、レイアウトが変化した時にも、調整が必要な箇所が少ない、という作りにできます。まぁ、ご参考まで。

退会済みユーザー

2018/09/19 00:39

メンテナンスのしやすさは重要ですよね。自分ではとても思いつかなかったので、非常に勉強になります。ありがとうございます。

行動規範の内容に同意します

セルのアドレスを文字列の状態で配列にして都度セルを取得するやり方で書いてみました。


Sub input_check()

'・申請区分１（D3,D4,D5,D6,D9,D12,E22,F22,D25,D28）
    Dim array1() As String
    array1 = Array("D3", "D4", "D5", "D6", "D9", "D12", "E22", "F22", "D25", "D28")
'・申請区分２（D5,D6,D11,D16,E34,F34,D36,D37）
    Dim array2() As String
    array2 = Array("D5", "D6", "D11", "D16", "E34", "F34", "D36", "D37")
'・申請区分３（D5,D6,D15,D16,E18,E19,D25,E35,D36）
    Dim array3() As String
    array3 = Array("D5", "D6", "D15", "D16", "E18", "E19", "D25", "E35", "D36")
    
    
    
    Dim r1 As range
    Dim strAddress
    For Each strAddress In array1
        Set r1 = range(strAddress)
        If (r1.Value = "") Then
            MsgBox "未入力セルがあります"
        End If
    Next
    
    For Each strAddress In array2
        Set r1 = range(strAddress)
        If (r1.Value = "") Then
            MsgBox "未入力セルがあります"
        End If
    Next
    
    For Each strAddress In array3
        Set r1 = range(strAddress)
        If (r1.Value = "") Then
            MsgBox "未入力セルがあります"
        End If
    Next
    
End Sub


Sub sinsei()

'・申請区分１（D3,D4,D5,D6,D9,D12,E22,F22,D25,D28）
    Dim array1() As String
    array1 = Array("D3", "D4", "D5", "D6", "D9", "D12", "E22", "F22", "D25", "D28")
'・申請区分２（D5,D6,D11,D16,E34,F34,D36,D37）
    Dim array2() As String
    array2 = Array("D5", "D6", "D11", "D16", "E34", "F34", "D36", "D37")
'・申請区分３（D5,D6,D15,D16,E18,E19,D25,E35,D36）
    Dim array3() As String
    array3 = Array("D5", "D6", "D15", "D16", "E18", "E19", "D25", "E35", "D36")
    
    Dim r1 As range
    Dim strAddress
    For Each strAddress In array1
        Set r1 = range(strAddress)
        r1.Interior.Color = RGB(255, 255, 153)
    Next
    
    For Each strAddress In array2
        Set r1 = range(strAddress)
        r1Interior.Color = RGB(255, 255, 255)
    Next
    
    For Each strAddress In array3
        Set r1 = range(strAddress)
        r1Interior.Color = RGB(255, 255, 255)
    Next
End Sub

投稿2018/09/18 00:39

編集2018/09/18 00:42

n_takapyon

総合スコア443

退会済みユーザー

2018/09/19 00:14

ご回答ありがとうございます。分かりやすいコードで大変参考になりました。

行動規範の内容に同意します

この方針はどうでしょうか？

チェックする対象セルの名前（B1とか）をCollection型の入れ物に入れる
Collectionに入っているものすべてについて、空かどうかを判断する関数を作る

配列でもできますが、Collectionという入れ物のほうが処理はすっきりすると思います。

これなら、あらかじめCollectionにセル名を入れるところは手間ではありますが、判断処理はFor Eachループでくるくる回して終わらせられますし、将来、対象セルが増減しても変更は少なくて済みます。
同じようなループを使えば色を変えるのもできますよね？良かったら参考にしてください。

なおサンプルコードはざっくりとしか書いていないので適宜補正してください。

vba
1Public Sub InputCheck()
2
3    ' コレクション型の入れ物に、チェック対象のセル名をあらかじめAddしておく
4    ' 配列と違って入れられる数に制限が無いのでこのほうが楽です
5    Dim targetCells As Collection
6    Set targetCells = New Collection
7    targetCells.Add ("A1")
8    targetCells.Add ("A2")
9    targetCells.Add ("A3")
10    targetCells.Add ("A4")
11    targetCells.Add ("A5")
12
13    ' チェックは「IsEmpty」関数におまかせ
14    MsgBox IsEmpty(targetCells)
15
16End Sub
17
18' セル名が入ったコレクションを受け取り、そこに書かれたセルのどれかが空ならTrue
19Public Function IsEmpty(cellNames As Collection) As Boolean
20
21    ' 判断結果を入れる変数
22    Dim result As Boolean
23    result = False
24
25    ' コレクション型は「For Each」でループさせられます。
26    Dim cellName As Variant
27    For Each cellName In cellNames
28        ' コレクションにはいったセル名を使ってRangeで中身を取り出し、空なら結果用変数をTrueに
29        If Trim(Range(CStr(cellName)).Value) = "" Then
30            result = True
31        End If
32    Next
33    
34    IsEmpty = result
35
36End Function

投稿2018/09/18 00:35

backyard

総合スコア534

backyard

2018/09/18 00:40

補足。For Eachループで空とわかった時のセル名をどこかに取っておけば、どのセルが空であるかもわかると思います。あとは適宜改造してもらえばなんとかなるのではないかと。 Collectionを使わない場合、配列の場合も基本的な考え方は同じです。String配列に「A3」とか対象のセル名を入れておいて、配列の先頭から終わりまでForループでチェックすればいけますね。

退会済みユーザー

2018/09/19 00:11

ご回答ありがとうございます。 Collectionを使用した書き方は知りませんでした。とても勉強になります。

行動規範の内容に同意します

あなたの回答