2次元配列に単一のセルを代入すると配列にならなくなる時の対処法を備忘録も兼ねて残しておきたいと思います。
2次元配列に単一のセルを代入すると配列にならなくなる
こんな感じのデータとコードがあったとします。
Sub get_Cell()
Dim ary_Cells As Variant
Dim last_Row As Long
last_Row = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If last_Row = 1 Then
MsgBox "データ件数が1件のため、処理を終了します。"
Exit Sub
End If
ReDim ary_Cells(1 To last_Row - 1, 1 To 1)
ary_Cells = Range("A2:A" & last_Row).Value
MsgBox "セルの個数：" & UBound(ary_Cells) & "個"
End Sub実行するとA1セルを除いたA列のセルを取得し、取得した個数が表示されます。
ここまでは大丈夫だと思うのですが、コードを変えずにデータ件数を1件にした状態で実行すると、MsgBox "セルの個数：" & UBound(ary_Cells) & "個"の行で「実行時エラー ’13’: 型が一致しません。」が発生してしまいます。
どうやら取得するセルが1つだけの場合、2次元配列に格納してもString型になってしまうようです。
（String型だとUboundが実行できない）
実際にウォッチ式を見てみるとString型になっているのが分かります。
対策
対策としては取得セルの個数の応じて格納処理を変えてあげます。
別途プロシージャを作成し、セルの個数に応じて取得元の指定を変えてあげます。
Sub set_Cell_Value(target_Ary As Variant, target_Cells As Range)
If UBound(target_Ary) = 1 Then
target_Ary(1, 1) = target_Cells
Else
target_Ary = target_Cells
End If
End Sub作成したら、ary_Cells = Range("A2:A" & last_Row).Valueの部分をCall set_Cell_Value(ary_Cells, Range("A2:A" & last_Row))に変更します。
Sub get_Cell()
...
ReDim ary_Cells(1 To last_Row - 1, 1 To 1)
Call set_Cell_Value(ary_Cells, Range("A2:A" & last_Row))
MsgBox "セルの個数：" & UBound(ary_Cells) & "個"
End Subこれでセルが1個の場合でも2次元配列に格納することができました。
もちろんFunctionでも実現可能です。
Sub get_Cell()
Dim ary_Cells As Variant
Dim last_Row As Long
last_Row = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If last_Row = 1 Then
MsgBox "データ件数が1件のため、処理を終了します。"
Exit Sub
End If
ReDim ary_Cells(1 To last_Row - 1, 1 To 1)
ary_Cells = func_set_Cell_Value(Range("A2:A" & last_Row))
MsgBox "セルの個数：" & UBound(ary_Cells) & "個"
End SubFunction func_set_Cell_Value(target_Cells As Range) As Variant
Dim buf_Ary As Variant
If target_Cells.Rows.Count = 1 Then
ReDim buf_Ary(1 To 1, 1 To 1)
buf_Ary(1, 1) = target_Cells.Value
Else
buf_Ary = target_Cells.Value
End If
func_set_Cell_Value = buf_Ary
End Function
コメント