ＶＢＡと線の作成

質問

ＶＢＡの初心者です。

今下の画像のような、エクセルのシートを
練習用に作りました。

列が4列あり、Ｃ列の店舗の
値が切り替わるごとに
下に太い罫線を引きたいのです。

手で作成できますが、参考に
ＶＢＡで自動に入力できるコード等は
あるのでしょうか。

列数は不変で4列とします。

よろしくお願いします。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.5

tom04 · ベストアンサー

No.4です！

補足の
＞一行目の項目名があるところまで
線を引く条件処理はできるのでしょうか。

に関してですが・・・

実は余計なお世話だと思いつつ、
前回のコードそのものが補足内容に対応できるコードにしていました。

ためしに1行目の項目列数を増やして前回のマクロを実行してみてください。

たぶん希望通りになると思いますよ。m(__)m

回答No.4

tom04

こんばんは！
すでに回答は出ていますので、参考程度で・・・

一例です。

Sub test()
Dim i, j As Long
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
j = Cells(1, Columns.Count).End(xlToLeft).Column '（質問ではj=4と決まっているので必要ないかも・・・）
If Cells(i, 3) <> Cells(i + 1, 3) Then
With Range(Cells(i, 1), Cells(i, j)).Borders(xlEdgeBottom)
'（変数jの設定をしない場合は　Cells(i,j) を Cells(i,4)　に変更してもOK）
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next i
End Sub

この場合最終行もアンダーラインが表示されますので、もしご希望でなければ
セルの選択と　Borders(xlEdgeBottom)　の部分を　Borders(xlEdgeTop)
で考えたり、最終行の調整で可能になると思います。

どうも失礼しました。m(__)m

補足

いつもありがとうございます。

完ぺきでした。

追加で補足ですが、一応
表の列数は、Ａ列からＭ列まで
で固定されています。

また、今後右に列が増えてくるかもれない
ですが、一行目の項目名があるところまで
線を引く条件処理はできるのでしょうか。

いつもすいません。

回答No.3

imogasi

指定した行の上（下）部に罫線をひくのは、その操作をシート上でして、マクロの記録を取り、そのセルの行番号がコードの何処で効いて居るか勉強のこと。
ーーー
＞「切り替わるごとに」とは東京から大阪のように、Ｃ列の値が変化したときか？
それならうえの行から１行ずつ処理していくが、直前の行の「店舗」列の値を、次（現在）に変数で送って（使えるように変数に記録して、次行で使って）
現在行で前行と比べ両者を比較して等しいときは、罫線を引くことはぜず、変わった場合のみセルの上辺に罫線を引けば仕舞い。
コントロールブレークのロジックと言い、同じ間は計数（件数）を足しこめば、店別合計が出せるロジックでも在る。
当然最初に店舗列でソートして作業することが前提。

回答No.2

keithin

sub sample1()
　dim i as long
　on error resume next
　range("A:D").borders.linestyle = xlnone
　for i = 2 to range("C65536").end(xlup).offset(-1, 0).row
　　if cells(i, "C").value <> cells(i + 1, "C").value then
　　　with cells(i, 1).resize(1, 4).borders(xledgebottom)
　　　　.linestyle = xlcontinuous
　　　　.weight = xlthin
　　　　.colorindex = xlautomatic
　　　end with
　　end if
　next i
end sub

ご相談に要件として書かれていない，たとえば
○最下端は「福岡」から「空白」に変わるのに線を引かない
○最上端は「タイトル行」から「最初のデータに変わる」のに線を引かない
といった部分を具体的にどうしたいのかによって，マクロの細工が少しずつ変わります。
寄せられた回答マクロをネタに，いろいろ勉強してみてください。

回答No.1

hallo-2007

こういうことでしょうか？
Sub ボタン1_Click()
For i = 2 To Range("C65536").End(xlUp).Row
If Range("C" & i).Value <> Range("C" & i + 1).Value Then
Range("A" & i & ":D" & i).Borders(xlEdgeBottom).LineStyle = xlContinuous
End If
Next
End Sub
短いコードなので意味を理解して使ってください。