VBA:空白の取得はできる？

質問

Excel2003で、従業員データを管理する表を作成してます。
1行づつ従業員人のデータがあります。(従業員名、住所、連絡TEL、取引先、取引先担当者、取引先TEL）
A列　従業員名、B列　住所、C列　連絡TEL、D列　取引先、E列　取引先担当者、F列　取引先TEL、です。
例えば、4行目の従業員が辞めた時A列からC列を削除します。
D列以降は取引先なので削除しません。
但し、その従業員が辞めた為、取引先とも取引を止めざるを得ない場合はD列以降も削除するので
（例えば）4行目は（A4：F4)は空白になります。
空白の場合、以下（例えば5行目以降）のデータを繰上げたいのですが、その為に空白を取得したいのですが？
（「A4～F4は空白である　」を取得出来ますか？）
一つのセルが空白か否かは取得出来たのですが・・・・
複数のセルが空白か否か取得出来るんでしょうか？
エクセル関係のサイトは探してみたんですが、わからなくて・・
ご教授願えたら嬉しいです。

回答No.7

imogasi · ベストアンサー

#6です。
＞A-F列にデータがない場合に表示はできますか？
If WorksheetFunction.CountBlank(Range(s)) = 6 Then
を
If WorksheetFunction.CountBlank(Range(s)) <> 6 Then
に変えるとどうですか。

お礼

返礼が遅くなりまして申し訳ありません。
＞If WorksheetFunction.CountBlank(Range(s)) <> 6 Then
ご回答のコードで、A-F列にデータがない場合を取得できました。
後は自分なりに修正してみます。お手数掛けました。
ありがとうございました。

回答No.8

Wendy02

こんにちは。

今回、サンプルコードを作ってみました。
何か、コードに癖をお持ちのようですので、なるべく早いうちに直したほうがよいです。どのような方法で作られたか分りませんが、imogasiさんのご指摘の「自分に合わせて」というのもごもっともな気がしますね。コードをみる限りは、一通りのVBAの勉強は終了したように読めますから。

それはともかく、気になった部分を指摘させていただきます。
--------------------------
On Error Goto の使い方は、エラートラップが発生した時に、飛ぶようにしますが、避けがたい（不可避）エラーを想定しますが、今回、エラーの発生する可能性はないはずですので使用しません。（私のサンプルをみてください）

また、Goto ステートメント(Gotoメソッドは別）は、VBA/VBでは、基本的に使わないことになっています。使わないで作る方法を探したほうがよいです。
--------------------------
MsgBox を条件文にする時は、

×If MsgBox("消去したデータは復活できません。本当に消去しますか？", vbOKCancel, "確認") Then
End If

If MsgBox("消去したデータは復活できません。本当に消去しますか？", vbOKCancel, "確認")=vbOk Then
　Exit Sub
End if
--------------------------
もしかしたら、この目的が、書式や罫線を削除しない目的で、値を移し変えているのでしょうか？ サンプルをみてください。

For j = i To LR
Range(Cells(j, 1), Cells(j, 6)).Value = Range(Cells(j + 1, 1), Cells(j + 1, 6)).Value
Next

'==============================

Private Sub CommandButton1_Click()
　 Dim i As Integer
　 Dim j As Integer
　 If TextBox1.Text = "" Then Exit Sub
　 i = CInt(TextBox1.Text)
　 If i < 11 Or i > 40 Then
　　　MsgBox "入力した値に誤りがあります。" & Chr(13) & "11～40までの整数を入力してください。", vbOKOnly + vbCritical, "確認"
　　　Exit Sub
　 End If

　 If MsgBox("消去したデータは復活できません。本当に消去しますか？", vbOKCancel, "確認") = vbCancel Then Exit Sub

　 'Wendy02の挿入行
　 If WorksheetFunction.CountA(Cells(i, 1).Resize(, 6)) = 0 Then

　　　MsgBox Cells(i, 1).Resize(, 6).Address(0, 0) & "は、空白です。"

　　　Cells(i, 1).Resize(, 6).ClearContents

　　　j = Range("B41").End(xlUp).Row
　　　Range(Cells(i, 1), Cells(j, 6)).Value = _
　　　Range(Cells(i + 1, 1), Cells(j + 1, 6)).Value

　 End If

　 Unload Me

End Sub

'------------------------------------
ただ、私がコードを書くのでしたら、目視で、A～F行が空なのは分りますから、わざわざ空白行を指定する必要がありません。VBA側で探させばよいわけです。
starsipさんのコードを元に、作ってみました。

Private Sub CommandButton2_Click()
Dim c As Range
Dim myRow As Range

On Error GoTo ErrHandler

　For Each c In Range(Cells(11, 1), Cells(Range("b65536").End(xlUp).Row, 6)).SpecialCells(xlCellTypeBlanks).Areas
　If c.Columns.Count = 6 Then
　　If MsgBox(c.Address(0, 0) & "を削除してよろしいですか？", vbInformation + vbOKCancel) = vbOK Then

　　　 c.ClearContents
　　　 c.Resize(Range(c, Range("B65536").End(xlUp)).Rows.Count).Value = _
　　　 c.Offset(c.Rows.Count).Resize(Range(c, Range("B65536").End(xlUp)).Rows.Count).Value

　　End If
　Else
　　'１部の行から空の場合
　End If
　Next
　MsgBox "終了します。", vbInformation
　On Error GoTo 0

Command2_Exit:
　Unload Me
　Exit Sub

ErrHandler:
　MsgBox "削除すべき行はありません。", vbInformation
Err.Clear
Resume Command2_Exit

End Sub

これは、2行に渡っていても削除できることなどが利点があります。
ただ、行の削除<.Deleteメソッド> を使って、書式・罫線を確保する方法は、PasteSpecial を使うことになるのですが、Copy する側の基準がややこしいそうな気がしましたので、やめました。

お礼

返礼が遅れまして申し訳ありません。
コードをご教授頂き、とても参考になりました。
まだまだ、勉強不足ですが頑張ってみます。
これからも宜しくお願いします。
ありがとうございました。

回答No.6

imogasi

#2です。＃２を修正してみました。
Private Sub CommandButton1_Click()
If Val(TextBox1.Text) < 11 Or Val(TextBox1.Text) > 40 Then
MsgBox "行指定範囲エラー"
Else
i = Val(TextBox1.Text)
s = "A" & i & ":" & "F" & i
If WorksheetFunction.CountBlank(Range(s)) = 6 Then
If MsgBox("消去したデータは復活できません。本当に消去しますか？", vbOKCancel, "確認") Then
Rows(i).Delete (xlUp)
End If
Else
MsgBox "A-F列にデータあり"
End If
End If
Unload UserForm1
End Sub
（＃２で
If WorksheetFunction.CountBlank(Range(s)) = 4
は＝６のミスでした。A-D列でテストやっていたため）
当初質問にUserFormなんて出ていなかったし、皆さんの回答を
自分に（UserFormありに）合わせて、質問者が修正できるようでないと回答を出しても意味がないと思いますが。
＃２の回答のポイントは
WorksheetFunction.CountBlank(Range(s))
の利用を示唆することしかないです。

お礼

再度のご回答ありがとうございます。
皆さんの意見を参考に修正はしているつもりなのですが・・
実力がなくて、ご迷惑を掛けます。
imogasiさんのコードですとA-F列にデータかある時にメッセージが表示されます。
確かに参考になりまして、ありがとうございます。
A-F列にデータがない場合に表示はできますか？
「他人に聞かないで自分で考えなさい」と言われれば、確かにそうなのですが・・

回答No.5

Wendy02

#4 の訂正です。

#入力してあるセルはいくつ数えても、0 ですから、以下のようにすればよいのでは（^^;
　　　↓
入力していないセルはいくつ数えても、
　　　　~~~~~~

回答No.4

Wendy02

こんばんは。

もう、回答がいくつかでていますし、まだ他に方法はあるのですが、入力してあるセルはいくつ数えても、0 ですから、以下のようにすればよいのでは（^^;

Sub BlankMovingUpRow()
Dim i As Long
i = 4
'実際は、For i = 最初の行　To 最後の行で、ループしてくださいね。
　If WorksheetFunction.CountA(Cells(i, 1).Resize(, 6)) = 0 Then
　 MsgBox Cells(i, 1).Resize(, 6).Address(0, 0) & "は、空です"
　 Cells(i, 1).EntireRow.Delete
　End If
End Sub

補足

ご回答ありがとうござます。
質問の仕方が悪かったかもしれません。
UserForm1で削除する行を指定します。
UserForm1で指定した行のA列からF列が全て空白の場合、メッセージを表示したかったのです。
以下現在のコードを記載します。

Private Sub CommandButton1_Click()
On Error GoTo case1
Dim RN As Integer
Dim i As Integer
Dim j As Integer
Dim LR As Integer
i = TextBox1.Text
If i < 11 Then
GoTo case1
End If
If i > 40 Then
GoTo case1
End If
If MsgBox("消去したデータは復活できません。本当に消去しますか？", vbOKCancel, "確認") Then
End If
Range(Cells(i, 1), Cells(i, 6)).ClearContents
LR = Range("b65536").End(xlUp).Row
For j = i To LR
Range(Cells(j, 1), Cells(j, 6)).Value = Range(Cells(j + 1, 1), Cells(j + 1, 6)).Value
Next
Unload UserForm1
Exit Sub
case1:
If MsgBox("入力した値に誤りがあります。" & Chr(13) & "11～40までの整数を入力してください。", vbOKOnly + vbCritical, "確認") Then
End If
End Sub

11行目から40行目にデータがあります。
UserForm1で指定した行のA列からF列が全て空白の場合、メッセージを表示できますか？

回答No.3

noname#187541

こんばんは。

COUNTBLANKを使うのはどうでしょうか。

A4:F4がすべて空白の場合は、
If WorksheetFunction.CountBlank(Range("A4:F4") = 6 Then
Rows(4).Delete (xlUp)
End If

お礼

ご回答ありがとうございます。
検討しましたが、今ひとつうまくいきません。
#4の方に補足しました。
宜しくお願い致します。

回答No.2

imogasi

A-F列が全て空白(DELキーを押したと同じ値）行を探す。
Sub test02()
For i = 2 To 10
s = "A" & i & ":" & "F" & i
If WorksheetFunction.CountBlank(Range(s)) = 4 Then
MsgBox i
End If
Next i
End Sub
少数例ではうまくいくが、質問者のケースでうまくいくかやってみてください。
Andなしで済ましたところがミソです。
実際はMｓｇBoxのところへ行削除のコードを入れます。

お礼

ご回答ありがとうございます。
検討しましたが、今ひとつうまくいきません。
#4の方に補足しました。
宜しくお願い致します。

回答No.1

fortranxp

それって例えばこういうことですか？
Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 200
If (Cells(i, 1).Value = "" And Cells(i, 2).Value = "" And Cells(i, 3).Value = "" And Cells(i, 4).Value = "") _
Then Rows(i).Delete
Next

End Sub

お礼

ご回答ありがとうございます。
検討しましたが、今ひとつうまくいきません。
#4の方に補足しました。
宜しくお願い致します。