エクセルでデータがある部分だけ範囲内の空白も込みで罫線で囲いたいです。

質問

エクセルでデータがある部分だけ範囲内の空白も込みで罫線で囲いたいです。

再質問です。
エクセルのファイルを開いて、データのある部分だけを罫線で囲みたいです。
データーは常に列数も行数も違います。
また空白の行があったり、列があったり一部のセルが空白だったり。
ここで教えてもらった記述があるのですがその時の質問は
（データのある部分だけ囲みたい）としたので、それに対応した記述の為

例えば
A1からM1まではデータがあり、
A2からM2までは空白
A3からM3まではデータがある場合とか

A1からM100までぎっしり埋まっている場合で
E列はE1からE100まで空白とか、

A1からM100までぎっしり埋まっている場合で
セルB5、C8、D12、E13だけは空白だと
空白部分は囲ってくれません。

又は
A1からM1まではデータがあり、
A2からM2までは空白
A3からM100まではデータがある場合とかだとA1からM1だけ囲まれますが
A2からM100までは囲まれません。

これはある意味（データーのある部分だけ）と質問したので仕方有りません。

自分でやるとマクロの記録しかできず以下のようになってしまいます。
これですと上記例でデータはA1からM100までで
3行目がなかったり、Ｄ列がなかったり、所々のセルに空白が
有りますが、罫線で囲うのはあくまでA1からM100までなのですが
以下の記述ではシート全てが罫線で囲まれてしまいます。
また対象のファイルは行数や列数が決まっているわけではないのです。
（100行かもしれないし1,000行かも知れない、Ｃ列までかも知れないし
　Ｚ列までかもしれません。
　1から10行までデータがあって100行空白で101行目からまたデータというほど
　の空白があるわけでもありません。）

どうすれば途中に空白があるデータの先頭から最後だけを囲えるのでしょうか？
空白も対象だとしてしまうとデーターの終わりがわからないから、
シート全部を囲うしかないのでしょうか？

Sub Macro1()
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
End Sub

回答No.4

myRange · ベストアンサー

----------------------------------　
With ActiveSheet.UsedRange.Borders
　　.LineStyle = xlContinuous
　　.Weight = xlThin
　　.ColorIndex = xlAutomatic
End With
----------------------------------

実際は、行、列の最終を調べてやるべきです。

お礼

ありがとうございます。
完璧に動作しました。
記述も短くて最高です。

補足

＞実際は、行、列の最終を調べてやるべきです。

コマンドボタンを押すと、別ファイルのエクセルを開き
いろいろな編集を行い、最後に罫線を引いて
ファイル名をシステム日付で付けて登録マクロを引きつかず
別ファイルで保存までする
という
プロシージャーの中に組み込ませたいのです。
よって開いて編集した最終を調べる事ができないのです。
申し訳ありません。

回答No.3

okormazd

Sub test()
Dim r, c As Long
r = ActiveSheet.UsedRange.Rows.Count
c = ActiveSheet.UsedRange.Columns.Count
With Range(Cells(1, 1), Cells(r, c))
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End Sub

forでまわさないだけ速いでしょう。

すでにあるプロシージャとくつけるのなら，
#1のお礼でエラーになるのは，Dim i,jで，iが前で宣言されているからでしょう。Dim jとすれば解消されるのではないですか。

これも，同様r,cが前に宣言されていれば，エラーになるので，Dimからはずす。

お礼

＞すでにあるプロシージャとくつけるのなら，
＞#1のお礼でエラーになるのは，Dim i,jで，iが前で宣言されているからでしょう。Dim jとすれば解消＞されるのではないですか。

＞これも，同様r,cが前に宣言されていれば，エラーになるので，Dimからはずす。

はい。iが前で宣言されていました。
この教えていただいたのはr,cが前に宣言されておらず
エラーにならずに実行できました。

あと、すごく速かったです。
5,000行ありますが、すでにあるプロシージャーの動作終了後
1秒以内で罫線引き終わりました。

ありがようございました。

回答No.2

tom04

再びお邪魔します。

補足にある問題点について、こちらでデータを削除、行挿入・列挿入・行削除・列削除の後
前回のコードのマクロを実行してみましたが、問題なくA1セルから最終行・最終列まで罫線が表示されました。
というわけで補足にある原因についてはちょっと判りかねます。（ごめんなさい）

それからエラーに関してですが、
（同じ適用範囲内で宣言が重複しています。）というエラーが出たのであればその通りに二重に宣言しているのだと思います。
コードをよくよく見返してみると同じ宣言をしている行がありませんか？

そして、最後にコードの長さについてですが、ちゃんと正常に作動するのであれば問題ないと思いますよ。
コードの記述は人それぞれですので、「これでないといけない！」ということはありません。

考え方・方法によってコードの記述は十人十色ですので、あまり気にしなくて良いと思います。
（コードの記述をみると個性はあるみたいですが・・・それはそれで良いのでは？
私個人的には　FOR～NEXTステートメントはよく使いたがる方です。）

重要なのは思った通りに動いてくれるかどうか？ということだと思います。

この程度ですが
ごめんなさいね。m(__)m

お礼

連結するプロシージャー内の一部に以下の記述がありました。

'A列とB列の数値データーを名称に変更

Dim i As Long
Dim Ar1 As Variant, Ar2 As Variant
Dim LastRow As Long
Ar1 = Array("", "入庫", "出庫", "返品")
Ar2 = Array("", "社内製品", "社外製品", "受入検査")
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRow
If IsNumeric(Cells(i, 1).Value) Then
If Cells(i, 1).Value > 0 And Cells(i, 1).Value < 4 Then
Cells(i, 1).Value = Ar1(Cells(i, 1).Value)
End If
End If
Next

'A列の値とB列の値から11,12,13列目に履歴表を作成
For i = 1 To LastRow
If IsNumeric(Cells(i, 2).Value) Then
If Cells(i, 2).Value > 0 And Cells(i, 2).Value < 3 Then
Cells(i, 2).Value = Ar2(Cells(i, 2).Value)
ElseIf Cells(i, 2).Value = 3 Then
Cells(i, 2).Value = Ar2(Cells(i, 2).Value)
Cells(i, 1).Value = Cells(i, 2).Value
End If
End If
If Cells(i, 11).Value <> "" Then
If Cells(i, 1).Value Like "入庫" Or Cells(i, 1).Value Like "返品" Then
Cells(i, 12).Value = Cells(i, 11).Value: Cells(i, 11).ClearContents
ElseIf Cells(i, 1).Value Like "出庫" Then
Cells(i, 13).Value = Cells(i, 11).Value: Cells(i, 11).ClearContents
End If
End If
Next
Application.ScreenUpdating = False

補足

補足にある問題点について

すいません。誤解を与えました。
これは教えてもらった内容を行う前に、独自で行った記述を
再チャレンジとして書きました。
でそれはそれで思ったように動作したのですが
根拠がなかったので、補足に書いてみました。
申し訳有りません。

教えていただいた内容では
＞こちらでデータを削除、行挿入・列挿入・行削除・列削除の後
＞前回のコードのマクロを実行してみましたが、
＞問題なくA1セルから最終行・最終列まで罫線が表示されました。

そのとうりで、ぜんぜん問題ありません。
ありがとうございました。

回答No.1

tom04

こんばんは！
こんな感じでも良いのですかね？
色々方法はあるかと思いますが、一例です。

A1セルは必ず何かが入力されているものとします。

Sub test()
Dim i, j As Long
For i = 1 To ActiveSheet.UsedRange.Rows.Count
For j = 1 To ActiveSheet.UsedRange.Columns.Count
With Cells(i, j)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
Next j
Next i
End Sub

参考になればよいのですが
的外れならごめんなさいね。m(__)m

お礼

ありがとうございます。単独なら動きました。
ですがすでに作成済みの他の編集マクロの記述の後に貼り付けてマクロを起動したら

Dim i, j As Long

のiに黄色が付いてコンパイルエラー
（同じ適用範囲内で宣言が重複しています。）
となります。

原因がわかりません。

作成済みのマクロ単独ではＯＫ。
作成済みマクロ起動前に教えていただいたマクロを起動ではＯＫ。
作成済みのマクロ起動で編集終了後に
教えていただいたマクロを起動でもＯＫ。

ですが作成済みのマクロとこの教えていただいた物を
連結させると駄目です。

ですが作成済みのマクロ文の最後に
Callで教えていただいたマクロを呼び出すと正常動作です。
なぜでしょうか？

補足

再チャレンジです。

Sub Macro3()

Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

これなら全シートは選択されません。
でも本当にこれでいいのか不安です。
記述も長いし。

これはマクロの記録で
セルA1を選択して、Ctrl＋End
を押して、罫線で格子を選んで終了です。

A1からM100までデータがあって
10列目に行挿入をして空白にして
C列に列挿入してN列まで増やして
A1からN101までに増えて、
セルN101をDELETEしましたが
A1からN101まで囲まれました。
DELETEや行挿入や列挿入したら
目には見えないけどデータがあると判断したのでしょうか。

Ctrl＋Aだと空白がある所のA1からC9までしか選択しませんので
いいのでしょうか？