エクセルのマクロ

質問

縦方向に連続したセルを選択状態にした時に、選択セルを基点として右横方向に連続してデータが入力されているセルを罫線で囲う、という処理をマクロで実行したいのですが。

例えば、以下の図で黒丸がデータ入力セルであるとすると、C1～C4を選択状態にして実行すると、C1～D1とC2～F2とC4が罫線で囲われます。

　ＡＢ　ＣＤ　ＥＦＧ
１○●●●○○○
２●●●●●●○
３○○○○○○○
４●●●○○○○

以下のマクロを実行すると、上図の3行目と4行目のところがかなり余計に罫線が引かれてしまいます。どう修正すればいいでしょうか？

Sub test1()
　yc = Selection.Rows.count
　aa = ActiveCell.Address

　For y = 0 To yc - 1
　ActiveCell.Offset(y, 0).Select
　Range(ActiveCell, ActiveCell.End _
　　　　　　(xlToRight)).Select

　　　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

　　　Range(aa).Select
　　Next y
End Sub

回答No.2

BLUEPIXY · ベストアンサー

'修正してみました
Sub test1()
Dim sel As Range
Dim x As Range
Dim endCell As Range

Set sel = Selection

For Each x In sel
If x.Value <> Empty Then
If x.Offset(0, 1).Value = Empty Then
Set endCell = x
Else
Set endCell = x.End(xlToRight)
End If
Range(x, endCell).Select
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
End If
Next
sel.Select
End Sub

お礼

ありがとうございました。
ＯＫでした。

回答No.4

m3_maki

No.3です。
With から END With までは
オリジナルのものに戻してください。
失礼いたしました。

お礼

了解です。

回答No.3

m3_maki

これでいかがでしょうか？
Sub test1()
yc = Selection.Rows.Count
aa = ActiveCell.Address
For y = 0 To yc - 1
ActiveCell.Offset(y, 0).Select
If ActiveCell <> "" Then
If ActiveCell.Offset(0, 1) <> "" Then
Range(ActiveCell, ActiveCell.End _
(xlToRight)).Select
End If
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

End If
Range(aa).Select
Next y
End Sub

お礼

ありがとうございました。
ＯＫでした。

回答No.1

KenKen_SP

>　Range(ActiveCell, ActiveCell.End _
>　　　　　　(xlToRight)).Select

これでは ActiveCell を基点にして、列方向の最終セルまでを選択している
だけです。必ずしも同一値の連続範囲を選択しているわけではありません。

また、C3 セルが除外されるのはなぜですか？
黒丸ではないから？

なら、その判定も抜けてますね。もう少しこの辺を整理して、動作の仕様を
説明して下さい。

それから細かな話ですが、、、

同じ Selection でも下から上に向かって選択したときと、上から下に
向かって選択した時とでは ActiveCell が違います。C4からC1を選択
した場合、ActiceCell は C4 です。したがって、

> For y = 0 To yc - 1
> ActiveCell.Offset(y, 0).Select

こう書いてしまうと、

ActiveCell.Offset(y, 0).Select

で C5 になってしまい、処理の対象範囲からいきなり外れてしまいますね。

お礼

ＡＢ　ＣＤ　ＥＦＧ
１○●●●○○○
２●●●●●●○
３○○○●●○○
４●●●○○○○

3行目が上記のようになっていても、C1～C4が選択状態で実行した場合は、罫線で囲われるのは、C1～D1とC2～F2とC4になります。

補足

ご指摘ありがとうございます。

＞また、C3 セルが除外されるのはなぜですか？
＞黒丸ではないから？

そうです。

＞下から上に向かって選択したときと、上から下に
＞向かって選択した時とでは

常に上から下で選択します。