配列内の要素が空だった場合、空要素を削除したい。

質問

お世話になります。
どなたかお助けください。

B7:B11のセルの値で、空ではないものをGlNaviA()に格納して
いき、GlNaviAのUboundを動的に変更しております。
ここで格納された空以外の要素をSub GlNaviに渡しているのですが、
正しく値が渡せていないみたいで、エラーになってしまいます…。
どこかおかしいとこはあるでしょうか。
プログラムは初心者レベルです…。

Option Explicit
Private GlNaviA() As Variant
Public cnt As Integer

Public Sub ABC()

省略…

cnt = 0
For i = 0 To 4
If SH2.Range("B" & i + 7).Value <> "" Then
ReDim Preserve GlNaviA(cnt)
GlNaviA(cnt) = SH2.Range("B" & i + 7).Value
cnt = cnt + 1
End If
Next i
　　MsgBox GlNaviA(cnt)

省略…

End Sub

Public Sub GlNavi(ByVal f As TextFile)
If UBound(GlNaviA) = 4 Then
f.TextWriteLine GlNaviA(0)
f.TextWriteLine GlNaviA(1)
f.TextWriteLine GlNaviA(2)
f.TextWriteLine GlNaviA(3)
f.TextWriteLine GlNaviA(4)
ElseIf UBound(GlNaviA) = 3 Then
f.TextWriteLine GlNaviA(0)
f.TextWriteLine GlNaviA(1)
f.TextWriteLine GlNaviA(2)
f.TextWriteLine GlNaviA(3)
ElseIf UBound(GlNaviA) = 2 Then
f.TextWriteLine GlNaviA(0)
f.TextWriteLine GlNaviA(1)
f.TextWriteLine GlNaviA(2)
ElseIf UBound(GlNaviA) = 1 Then
f.TextWriteLine GlNaviA(0)
f.TextWriteLine GlNaviA(1)
Else
f.TextWriteLine GlNaviA(0)
End If
End Sub

回答No.7

korin_

こんにちは。#6です。
多分、私が提示したソース以外の部分で何かしていると思います。
こちらでは、空でない要素が2以下になっても正常に動作しています。

具体的にどこでどんなエラーになるのかを教えていただいた方が解決に近づくと思います。

お礼

korin_様　回答ありがとうございます！

先ほど教えていただいた内容でばっちりあってました！！
エラーが出たのは、私の凡ミスですorz

Public Sub GlNavi(ByVal f As TextFile)
If UBound(GlNaviA) = 4 Then
　省略
ElseIf UBound(GlNaviA) = 1 Then
f.TextWriteLine GlNaviA(0)
f.TextWriteLine GlNaviA(2) ←これ…でしたorz
End Sub

すっきり片付きました！
本当にありがとうございました！

回答No.6

korin_

何度もすみません。
質問者さんの最初のソースに初期化処理を入れる方が簡潔で良いかもしれません。こんな感じで。

cnt = 0
ReDim GlNaviA(0)
For i = 0 To 4
If SH2.Range("B" & i + 7).Value <> "" Then
ReDim Preserve GlNaviA(cnt)
GlNaviA(cnt) = SH2.Range("B" & i + 7).Value
cnt = cnt + 1
End If
Next i

補足

korin_様　回答ありがとうございます。
こちらこそ何度もすいませんorz

上記を試したところ、空では無い要素が3つ以上ある場合は、エラーが
なく上手く動作します！
ただし、空では無い要素が2以下になった場合に、エラーが発生してしまいます…。

回答No.5

AKARI0418

すいませんひとつ間違いがあったため訂正します。
redim GlNaviA(cnt)
ではなく
redim GlNaviA(cnt-1)
でした。

私の環境ではうまく動きました、MsgBox UBound(GlNaviA)では要素-1の値をとることができました。

ほかに考えられるとすると、セルにスペースが入ってしまっていればうまくいかないと思います。Trim(SH2.Range("B" & i + 7).Value)と記述するとスペースをトリミングしてくれるので、試してみてください。
下記がソースです。

For i = 0 To 4
If Trim(SH2.Range("B" & i + 7).Value) <> "" Then
cnt = cnt + 1
End If
Next i
ReDim GlNaviA(cnt-1)
cnt = 0
For i = 0 To 4
If Trim(SH2.Range("B" & i + 7).Value) <> "" Then
GlNaviA(cnt) = Trim(SH2.Range("B" & i + 7).Value)
cnt = cnt + 1
End If
Next i

お礼

AKARI0418 様
今回の件、無事解決することができました。
最後までお付き合いいただきありがとうございました！！

補足

AKARI0418様　回答ありがとうございます。
上限は4まで、下限0までの間で動的に変化させたいのですが
上記を試したところ
Ubound(GlNaviA)で7を返してきます…。
質問させていただいてる箇所以外が問題なんですかねorz

回答No.4

korin_

こんにちは。

> MsgBox Ubound(GlNaviA)で確認すると4となり、
> Public Sub GlNavi(ByVal f As TextFile)で
> 必要ない行まで書き出されてしまいます…。

一番最初に cnt = 0 と初期化するのを忘れていませんか？

ちなみに#1さんの提示されたコードでは
> ReDim Preserve GlNaviA(cnt)
となっていますが、このタイミングでは初期化するだなので
> ReDim GlNaviA(cnt)
の方が良いです。
配列にセットしたデータを記憶したまま、新しく要素を追加する場合のみ ReDim Preserve を使用してください。

回答No.3

imogasi

エクセルVBAの問題で、（VBからでなく）エクセルから実行できればよいのですよね。
質問の路線にこたえてないのですが、
空白セルを除いて捉えるなら
Sub test01()
Dim cl
For Each cl In Range("a1:A10")
If Intersect(cl, Range("a1:A10").SpecialCells(xlCellTypeBlanks)) Is Nothing Then
MsgBox cl 'ここで必要な処理をする
End If
Next
End Sub
またはMsgboxのところで配列にすれば、あるいは各セルについて
単純に空白かどうか聞いて配列データ化すればよいように思いますが、全体でやりたいこととの関連でこれでは役立たないですか。

補足

imogasi様　回答ありがとうございます。

>Sub test01()
>Dim cl
>For Each cl In Range("a1:A10")
>If Intersect(cl, >Range("a1:A10").SpecialCells(xlCellTypeBlanks)) Is Nothing >Then
>MsgBox cl 'ここで必要な処理をする
>End If
>Next
>End Sub

上記を試したところ、空白以外の要素をMsgBoxにて確認することが
できましたが、Public Sub GlNaviへclのUboundを渡せておらず、
値の書き出しもできません…。

>Msgboxのところで配列にすれば
これはまだ、cl= Array(空白以外の要素)になっていない
ということでしょうか。

配列化するということは、

Sub test01()
Dim cl
Dim GlNaviA As Variant

ReDim GlNaviA(0)
For Each cl In Range("a1:A10")
If Intersect(cl, Range("a1:A10").SpecialCells(xlCellTypeBlanks)) Is Nothing Then
For i = 0 To Ubound(cl)
GlNaviA(i) = cl(i)
ReDim GlNaviA(i)
Next i
End If
Next
End Sub

でいいのでしょうか。

回答No.2

korin_

こんにちは。

おそらく、ReDim Preserve が行われなかった(追加する要素が1つもなかった)場合にエラーが起きてますよね？
配列は、長さを指定せずに宣言した場合には長さが未定義の状態です。
その状態でUBoundやLBoundを行うと、エラーとなります。

GlNaviA()を定義した後に、
GlNaviA() = Split(vbNullString, vbNullChar)
を追加すれば、長さ0の配列を作成した扱いになり、エラーはおきないと思います。

補足

korin_様　回答ありがとうございます。

Option Explicit
Private GlNaviA() As Variant
Public cnt As Integer

Public Sub ABC()

GlNaviA() = Split(vbNullString, vbNullChar)

省略…

cnt = 0
For i = 0 To 4
If SH2.Range("B" & i + 7).Value <> "" Then
ReDim Preserve GlNaviA(cnt)
GlNaviA(cnt) = SH2.Range("B" & i + 7).Value
cnt = cnt + 1
End If
Next i
MsgBox GlNaviA(cnt)

省略…

End Sub

上記で実行してみたのですが、やはり値を正しく渡すことが
できません。

>配列は、長さを指定せずに宣言した場合には長さが未定義の状態です。
>その状態でUBoundやLBoundを行うと、エラーとなります。

大変参考になります。ありがとうございます。

回答No.1

AKARI0418

ReDim Preserve GlNaviA(cnt)のタイミングが問題だと思います。

Redimをおこなうと、その要素の初期化を行います、そのためこのプログラムだと、最後にRedimを行った、i=4の場合の値のみが格納されていることになります。

たとえばですが、以下のように修正すれば、上記の問題は解決できます。
For i = 0 To 4
If SH2.Range("B" & i + 7).Value <> "" Then
cnt = cnt + 1
End If
Next i
ReDim Preserve GlNaviA(cnt)
cnt = 0
For i = 0 To 4
If SH2.Range("B" & i + 7).Value <> "" Then
GlNaviA(cnt) = SH2.Range("B" & i + 7).Value
cnt = cnt + 1
End If
Next i

補足

AKARI0418様　回答ありがとうございます。

>For i = 0 To 4
>If SH2.Range("B" & i + 7).Value <> "" Then
>cnt = cnt + 1
>End If
>Next i
>ReDim Preserve GlNaviA(cnt)
>cnt = 0
>For i = 0 To 4
>If SH2.Range("B" & i + 7).Value <> "" Then
>GlNaviA(cnt) = SH2.Range("B" & i + 7).Value
>cnt = cnt + 1
>End If
>Next i

上記を試してみたところ、空では無い要素のみを
渡すことに成功しました。
しかし、
MsgBox Ubound(GlNaviA)で確認すると4となり、
Public Sub GlNavi(ByVal f As TextFile)で
必要ない行まで書き出されてしまいます…。

現在、セルの値は下記のようになっています。
B7 コンテンツ1
B8
B9 コンテンツ2
B10
B11

格納される値は、下記のようにしたいです。
GlNavi = Array("コンテンツ1",コンテンツ2)

まだ他に直すべき箇所はありますでしょうかorz