列に見た目で データがなければ列ごと削除する方

質問

excel2010

題名には列にデータがなければとしていますが、見た目でデータの表示がなければ列を削除する方法を教えていただきたく。

H4セルに
=IF(ISNA(HLOOKUP($A4,work!$C$2:$AM$8,3,FALSE)),"",HLOOKUP($A4,work!$C$2:$AM$8,3,FALSE))
I4セルに
=IF(ISNA(HLOOKUP($A4,work!$C$2:$AM$8,4,FALSE)),"",HLOOKUP($A4,work!$C$2:$AM$8,4,FALSE))
J4セルに
=IF(ISNA(HLOOKUP($A4,work!$C$2:$AM$8,5,FALSE)),"",HLOOKUP($A4,work!$C$2:$AM$8,5,FALSE))
という式が入っています。

K列には、自由記述する列を設けています。

上記式を必要な行数だけプルダウンコピーするので、行数は可変します。
H列からJ列までは、セルの書式設定－ユーザ定義ー種類で#としています。
HLOOKUPの参照結果がない時に0を表示しない様にするためです。

列のデータはH列からJ列の順に参照結果が反映されます。
（Hの参照結果がなくてIの参照結果を表示ということはありません。）

この様な環境で、見た目上、HLOOKUPの参照結果がなければ、
列を非表示、あるいは削除したいのですが、どの様な構成で実施すればよいでしょうか？

セルのデータがなければ下記の構成で対応可能ですが、見た目上で空白セルになっているだけで、実際には式が入っており、参照結果がある列だけを残したいのです。

--------------------------------------------------------------------------
一例です。（A:E列範囲としています）
For i = 5 To 1 Step -1
If Application.CountA(Columns(i)) = 0 Then Columns(i).Delete
Next
---------------------------------------------------------------------------

回答No.5

real beatin（@realbeatin） · ベストアンサー

＃４に書き忘れが有ったので、補足、訂正です。

>　　　　If j > nLast Then Range("4:9").Columns(i).Interior.Color = vbRed
の記述の内、「 Range("4:9").Columns(i).Interior.Color = vbRed」
の部分は、
いちいち削除してしまうと、どの列が削除されたのか、結果の検証が困難なので、
テスト用・検証用の記述として、仮に実行させる処理内容でした。
テストが済んでから実際の処理「Columns(i).Delete」に書き換えて貰おうと
思っていたのですが、書き忘れました。
実際に動かすコードは、以下、です。

' ' ///

Sub Re8990454w_cc()
Dim i As Long, j As Long, nLast As Long
　　For i = 12 To 8 Step -1　'　要指定■H:L 列に相当
　　　　nLast = Cells(Rows.Count, i).End(xlUp).Row
　　　　For j = 4 To nLast　'　要指定■４行めから最終行に相当
　　　　　　If Cells(j, i) <> "" And Cells(j, i) <> 0 Then Exit For
　　　　Next j
　　　　If j > nLast Then Range("4:9").Columns(i).Interior.Color = vbRed
　　Next
End Sub

' ' ///

お礼

何度もすばやい回答をしていただき、ありがとうございました。
望み通りの内容が実現できました。

Columns(i).Deleteの部分は、分かりました。

実際に動かすコードは、以下です
が、元と同じでしたけど…。

回答No.6

kagakusuki

>参照H,I,J列に参照結果がない例でマクロ実行した場合。
>２列分削除される。どの列が削除されたかは分かりません。
>K列が備考欄だったものが、I列が備考欄になりました。

>参照H列のみに参照結果がある例でマクロ実行した場合。
>１列分削除される。どの列が削除されたかは分かりません。
>Ｈ列の参照結果がある列は残っています。
>K列が備考欄だったものが、Ｊ列が備考欄になりました。

>参照H、Ｉ列に参照結果がある例でマクロ実行した場合。
>１列分削除される。
>Ｈ，Ｉ列の参照結果がある列は残っています。
>K列が備考欄だったものが、Ｊ列が備考欄になりました。

>参照H，Ｉ，Ｊ列に参照結果がある例でマクロ実行した場合。
>削除される列はない。
>Ｈ，Ｉ，Ｊ列は残っています。

　申し訳御座いません。確認の仕方が甘かった様です。
　改良致しましたので下記のVBAをお試し下さい。

Sub QNo8990454_列に見た目でデータがなければ列ごと削除する_改()

Dim c As Range, myRows As Long, myRange As String

myRange = "H4:J4"

With ActiveSheet
myRows = .Range("A" & Rows.Count).End(xlUp).Row - Range("A4").Row + 1
If myRows < 0 Then
MsgBox "データが見つかりませんでしたので処理を行う事が出来ません。" _
& vbCrLf & "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If
For Each c In .Range(myRange)
If c.Formula = "" Then c.Formula = "="""""
With Application.WorksheetFunction
If .CountIf(c.Resize(myRows, 1), "*?") + .Count(c.Resize(myRows, 1)) _
- .CountIf(c.Resize(myRows, 1), 0) = 0 Then c.ClearContents
End With
Next c
On Error Resume Next
.Range(myRange).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
On Error GoTo 0
For Each c In .Range(myRange)
If c.Formula = "=""""" Then c.Formula = ""
Next c
End With

End Sub

回答No.4

real beatin（@realbeatin）

＃１-２です。＃１お礼欄・補足欄、拝見しました。

> 参照した結果は数値ではありません。文字列になります。
> またあとから行を追加等の処理も入っているので、まったくの空欄セルも存在します。

了解です。やはり読み違えていたようですね。すみません。
補足内容を反映させ修正を加えたもので、お応えします。
「「「0 でない」且「""空文字でない」セル」が１つでもある列」以外の列
を削除します。
要指定■の行の、For 文のカウンタの数値は、
「何列めから」 To 「何列めまで」　（サンプルではH:L 列に相当）
「何行めから」 To　　　　　（サンプルでは４行めから最終行に相当）
の３ヶ所、過不足が無いように指定し直してから動かしてください。

> =SUM(LEN(H:H))の結果は"1"になります。
> 参照した結果の数に無関係で"1"で変わらずでした。
あ、すみませんでした。
確かに普通の配列数式ではうまくいきませんね。
＃１のものに「0 値」への対応を追加したEvaluateメソッドでは
計算させるとちゃんと結果は出ているのですが、
紛れないように今回は割愛します。

ＶＢＡの初級で習う、極々基本的な書法、一点に絞ってお応えします。

蛇足ですが、数式について、
0 値を返すのは、そのままでいいと思いますが、
旧いバージョンへの互換を意識しないで済むのなら、
=IFERROR(HLOOKUP($A4,work!$C$2:$AM$8,3,FALSE),"")
のように、セル範囲への参照がなるべく重複しない数式
にしてみては如何でしょうか。
（もしかしたら#N/A と他のエラー値を区別する意図なのかも、ですが。）

以下、修正版です。

' ' ///

Sub Re8990454w_c2()
Dim i As Long, j As Long, nLast As Long
　　For i = 12 To 8 Step -1　'　要指定■H:L 列に相当
　　　　nLast = Cells(Rows.Count, i).End(xlUp).Row
　　　　For j = 4 To nLast　'　要指定■４行めから最終行に相当
　　　　　　If Cells(j, i) <> "" And Cells(j, i) <> 0 Then Exit For
　　　　Next j
　　　　If j > nLast Then Range("4:9").Columns(i).Interior.Color = vbRed
　　Next
End Sub

' ' ///

回答No.3

kagakusuki

確認したいのですが、

=IF(ISNA(HLOOKUP($A4,work!$C$2:$AM$8,○,FALSE)),"",HLOOKUP($A4,work!$C$2:$AM$8,○,FALSE))

という形式の関数が入力されているのは4行目以下であり、4行目以下にあるセルの値が全て空欄か0の場合には、例えH1:J3の範囲に項目名等の何らかのデータが存在していた場合であってもその列は削除するという事で宜しいのでしょうか?
　それならば次の様なVBAマクロとなります。

Sub QNo8990454_列に見た目でデータがなければ列ごと削除する()

Dim c As Range, myRows As Long

myRows = Range("A" & Rows.Count).End(xlUp).Row - Range("A4").Row + 1
If myRows < 0 Then
MsgBox "データが見つかりませんでしたので処理を行う事が出来ません。" _
& vbCrLf & "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If
For Each c In Range("H4:J4")
With Application.WorksheetFunction
If .CountIf(c.Resize(myRows, 1), "*?") + .Count(c.Resize(myRows, 1)) _
- .CountIf(c.Resize(myRows, 1), 0) = 0 Then c.EntireColumn.Delete
End With
Next c

End Sub

　後、余談になりますが、H4～J4セルに入力するワークシート関数を次の様にしておきますと、参照すべきデータが無い場合には、0が表示される事無く、表示は空欄となりますので、

>セルの書式設定－ユーザ定義ー種類で#としています。
>HLOOKUPの参照結果がない時に0を表示しない様にするためです。

等といった対策を講じる必要が無くなります。

H4セルの関数

=IF(ISERROR(1/(HLOOKUP($A4,work!$C$2:$AM$8,3,FALSE)<>"")),"",HLOOKUP($A4,work!$C$2:$AM$8,3,FALSE))

I4セルの関数

=IF(ISERROR(1/(HLOOKUP($A4,work!$C$2:$AM$8,4,FALSE)<>"")),"",HLOOKUP($A4,work!$C$2:$AM$8,4,FALSE))

J4セルの関数

=IF(ISERROR(1/(HLOOKUP($A4,work!$C$2:$AM$8,5,FALSE)<>"")),"",HLOOKUP($A4,work!$C$2:$AM$8,5,FALSE))

お礼

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

補足

関数が入力されているのは4行目以下であり、4行目以下にあるセルの値が全て空欄か0の場合には、例えH1:J3の範囲に項目名等の何らかのデータが存在していた場合であってもその列は削除するという事でよいです。
提示していただいたマクロを動作させた結果は次の通りです。

参照H,I,J列に参照結果がない例でマクロ実行した場合。
２列分削除される。どの列が削除されたかは分かりません。
K列が備考欄だったものが、I列が備考欄になりました。

参照H列のみに参照結果がある例でマクロ実行した場合。
１列分削除される。どの列が削除されたかは分かりません。
Ｈ列の参照結果がある列は残っています。
K列が備考欄だったものが、Ｊ列が備考欄になりました。

参照H、Ｉ列に参照結果がある例でマクロ実行した場合。
１列分削除される。
Ｈ，Ｉ列の参照結果がある列は残っています。
K列が備考欄だったものが、Ｊ列が備考欄になりました。

参照H，Ｉ，Ｊ列に参照結果がある例でマクロ実行した場合。
削除される列はない。
Ｈ，Ｉ，Ｊ列は残っています。

このマクロを２回続けて実行すると望んでいた構成（空欄セルが削除状態）になるので、次の構成で進めます。

備考列をK列からＨ列に変更。
これに伴い、下記に変更
For Each c In Range("H4:J4")
→
For Each c In Range("I4:K4")

本文からこのマクロを２回実行
としました。
マクロ初心者としては、これぐらいしか出来ません。

もし、よろしければ、何故１回で空欄列全てが削除できないのか、
教えていただければと思っています。

※
H4セルの関数

=IF(ISERROR(1/(HLOOKUP($A4,work!$C$2:$AM$8,3,FALSE)<>"")),"",HLOOKUP($A4,work!$C$2:$AM$8,3,FALSE))

助かりました。今後、これで使いたいと思います。

回答No.2

real beatin（@realbeatin）

＃１です。追加です。

読み返してみて気になったのですが、
> H列からJ列までは、セルの書式設定－ユーザ定義ー種類で#としています。
> 見た目上、HLOOKUPの参照結果がなければ、
　work!C4:AM6
には、（値も数式も何も設定していない）空のセルがあるのですか？
あるとして、ご提示の数式の戻り値が、0 である場合、
見た目上は、表示形式で何も無いように見えるから、
0 値を返す場合も「ない」ものといして扱う、
というようなことだったりしますか？
「参照結果がない」というのは、エラー値#N/Aを意味しているように
受け止めていましたが、
0 値を返す場合、実際は戻り値がある、のに、これを「参照結果がない」
（∵0は表示されないから）という意図で書かれていますか？

こちらの理解が至らなくて、まだ解決していない場合は、
補足説明をお願いします。

お礼

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

補足

work!C4:AM6
には、（値も数式も何も設定していない）空のセルがあるのですか？
→空のセルあります。

あるとして、ご提示の数式の戻り値が、0 である場合、
見た目上は、表示形式で何も無いように見えるから、
0 値を返す場合も「ない」ものといして扱う、
というようなことだったりしますか？
→０は「ない」ものです

「参照結果がない」というのは、エラー値#N/Aを意味しているように
受け止めていましたが、
0 値を返す場合、実際は戻り値がある、のに、これを「参照結果がない」
（∵0は表示されないから）という意図で書かれていますか？

0値は参照結果が無いという認識です。
なので、見た目上で書式セルを＃として空欄の様な扱いにしています。

回答No.1

real beatin（@realbeatin）

こんにちは。

数値または""空文字であることが担保されているならば、
COUNT関数でいけますよね。

念の為、
""空文字以外の文字列値を含めて、無い、という判定をするなら、
普通にループで、""空文字以外の文字が見つかれば、ループを抜ける、
的なやり方でいいように思います。

ついで、Excel数式ならどうするか考えてみたら、
=SUM(LEN(A:A))　→　（Ctrl+Shift+Enter）
みたいな数式でチェック出来ますから、
EvakuateメソッドでExcelに計算させた結果で判別するとか、
も、アリでしょう。

ただ、今回は前提が、
数式の戻り値に対する判別ではあるものの、
エラー値を返すような数式設定や運用はいていないだろう、
という推測の基、
'　すべての型の値をチェック（エラー値を含むとエラー）
と書かれた２つについては、
エラー値を含む場合の対策は省略しています。

' ' ///

Sub Re8990454w_a()　'　数値のみチェック
Dim i As Long
　　For i = 5 To 1 Step -1
　　　　If WorksheetFunction.Count(Columns(i)) = 0 Then Columns(i).Delete
　　Next
End Sub

Sub Re8990454w_c()　'　すべての型の値をチェック（エラー値を含むとエラー）
Dim i As Long, j As Long, nLast As Long
　　For i = 5 To 1 Step -1
　　　　If WorksheetFunction.Count(Columns(i)) = 0 Then
　　　　　　nLast = Cells(Rows.Count, i).End(xlUp).Row
　　　　　　For j = 1 To nLast
　　　　　　　　If Cells(j, i) <> "" Then Exit For
　　　　　　Next j
　　　　　　If j > nLast Then Columns(i).Delete
　　　　End If
　　Next
End Sub

Sub Re8990454w_j()　'　すべての型の値をチェック（エラー値を含むとエラー）
Dim i As Long, nLast As Long
　　For i = 5 To 1 Step -1
　　　　nLast = Cells(Rows.Count, i).End(xlUp).Row
　　　　If ActiveSheet.Evaluate("=SUM(LEN(" & Cells(i).Resize(nLast).Address & "))") = 0 Then Columns(i).Delete
　　Next
End Sub

お礼

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

補足

参照した結果は数値ではありません。文字列になります。
またあとから行を追加等の処理も入っているので、まったくの空欄セルも存在します。
=SUM(LEN(H:H))の結果は"1"になります。
参照した結果の数に無関係で"1"で変わらずでした。