Excel VBA 選択されている複数の空白セルのセル番地を、他のブックのセルに表示させる方法

Excel VBAについての質問です。

マクロで、選択している複数の空白セルのセル番地を、他のブックのセルに記入し、空白セルの一覧を作りたいのです。
方法がございましたら、ご教授お願いします。

現在はデータの中から空白セルをすべて選択し、他のブックのシートのセルにセル番地を表示させることはできているのですが、$E$7のような表示になり、空白セルはたくさんあるのに１つしか表示されません。どうすればいいのでしょうか。

No.1 回答者： GooUserラック 回答日時： 2016/05/20 17:38

別シート（Sheet2）に書き出すものを作りましたがこんな事でしょうか？

Sub Macro1()

Dim 行 As Long
Dim 個目 As Long

Sheets("Sheet2").Columns("A:A").ClearContents
For 個目 = 1 To Selection.Count
If Selection(個目).Value = "" Then
行 = 行 + 1
Sheets("Sheet2").Cells(行, 1).Value = Selection(個目).Address(rowAbsolute:=False, ColumnAbsolute:=False)
End If
Next

End Sub

この回答へのお礼

一番最初にご回答ありがとうございました！
参考にさせていただきます。

皆様がご親切に知恵をくださったおかげでだんだんできあがってきています。感謝します(T_T)

お礼日時：2016/05/23 18:00

No.2 回答者： GooUserラック 回答日時： 2016/05/20 17:45

↓ [Ctrl]キーを使って複数のエリアを選んだ場合は正常に動きません。

この回答へのお礼

ご回答どうもありがとうございます。先ほど教えていただいたコードを見ながら試そうとしたのですが、たくさんのデータの中から空白セルを探し出すので、 [Ctrl]↓も使って複数の空白セルを選択している状態なのですが、それでは動かないということでしょうか？
今書いているコードは、

Dim str
str = Range("D8").Value

Dim ca As String
ca = ActiveCell.Address

Workbooks.Open Filename:=".\" & Range("D7").Value & ".xls"
'D7に記入されているブック名のブックを開く

Worksheets(str).Select
'D8に記入されているシート名のシートを選択する

Range("P22:V22").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
'ここで [Ctrl]↓などを使ってデータの範囲を選択し、その中から空白セルだけを見つけて選択する

Workbooks("エラーチェック.xlsm").Worksheets("sheet1").Range("E7") = ca
'エラーチェックというブックの"sheet1"のセルE7に、見つけた空白セルのセル番地を記入していって一覧にする←ここができないのです。

お礼日時：2016/05/20 18:02

No.3 回答者： WindFaller 回答日時： 2016/05/20 18:12

>$E$7のような表示になり、空白セルはたくさんあるのに１つしか表示されません。

私は、勘違いしているかもしれませんが、参考にしてみてください。
以下は、BlankCells.Cells　　のCells を取っても同じようです。
Seelection でやったら、ちょっと面倒くさそうですね。

'//
Sub ListBlankCells()
Dim Rng As Range
Dim c As Range, i As Long
Dim BlankCells As Range
'**範囲を決めてください**
Set Rng = Range("A1:H10")
'*********************
On Error Resume Next
Set BlankCells = Rng.SpecialCells(xlCellTypeBlanks)
If Err.Number <> 0 Then
　　 MsgBox "空白セルはありません。", vbInformation
　　 Exit Sub
End If
On Error GoTo 0
''まとめて書き出す
For i = 1 To BlankCells.Areas.Count
　Worksheets("Sheet2").Cells(i, 1).Value = _
　　 BlankCells.Cells.Areas(i).Address(0, 0)
Next i


''一個一個書き出す
'i = 1
'For Each c In BlankCells.Cells
' Worksheets("Sheet2").Cells(i, 1).Value = _
'　　　　c.Address(0, 0)
'　　　　i = i + 1
'Next c

End Sub

'//

この回答へのお礼

空白セルがなかった場合のメッセージボックスまで考えてくださったんですか！たしかにメッセージボックスが出るようにしたほうがいいですね。
ありがとうございます！

皆様のご回答を参考にしながらコードを書いていろいろ試しているのですが、やはり私には難しくて思うようにいかないのですけど、だんだん出来上がってきてはいます！
本当に感謝します！！（T_T）

お礼日時：2016/05/23 17:49

No.4 ベストアンサー 回答者： GooUserラック 回答日時： 2016/05/20 19:10

図のように選択箇所が重なっていると重複してしまいますが、あとで削除すれば良いのでとりあえず。

Sub Macro2()

Dim 範囲 As Range
Dim 行 As Long
Dim 個目 As Long

Sheets("Sheet2").Columns("A:A").ClearContents
For Each 範囲 In Selection.Areas
For 個目 = 1 To 範囲.Count
If 範囲(個目).Value = "" Then
行 = 行 + 1
Sheets("Sheet2").Cells(行, 1).Value = 範囲(個目).Address(RowAbsolute:=False, ColumnAbsolute:=False)
End If
Next
Next

End Sub

この回答へのお礼

画像まで添付してわかりやすくご回答してくださり、ご親切にどうもありがとうございます！！
そんな感じにしたいのです！

今皆様のご回答を参考にしながらコードを書いていろいろ試しているのですが、やはり私には難しくて思うようにいかないのですけど、だんだん出来上がってきてはいます！

別ブックのシートに正しいセル番地を入力するところまでできまして、あとは入力するセルを＋１していけば完成です。
おかげさまでイメージ通りのものが作れそうです！
本当に感謝します！！（T_T）

お礼日時：2016/05/23 17:56

No.5 回答者： ママチャリ 回答日時： 2016/05/20 20:03

こんな感じでどうでしょう。

転記先のクリアやエラー処理は組み込んでいませんので、お好みで･･･。

Sub sumple()
Dim r As Range
Dim I As Long
For Each r In Selection
If r.Value = "" Then
I = I + 1
Sheets("Sheet2").Cells(I, "A") = r.Address(False, False)
End If
Next
End Sub

この回答へのお礼

ご回答ありがとうございます！
For Each～などがよくわからず困っていたのですが、参考にさせていただきます！

皆様がご親切に知恵をくださったおかげでもうすぐ完成させられそうです。感謝します(T_T)

お礼日時：2016/05/23 17:59