excelで罫線を引くマクロを教えてください

質問

エクセルで、以下のような表があったとします

商品コード　　商品名　　商品の特徴
０００１　　　商品１　　　商品１の特徴１
　　　　　　　　　　　　　　　商品１の特徴２
０００２　　　商品２　　　商品２の特徴１
　　　　　　　　　　　　　　　商品２の特徴２
　　　　　　　　　　　　　　　商品２の特徴３
　　　　　　・
　　　　　　・
　　　　　　・

この場合に、一つの商品の情報を実線で囲み、その中を
１行づつ横に点線を引くという作業がしたいのです。

ただ、その時によって商品の数が変わるため、
(1)一つの商品の範囲を認識して罫線を引く
(2)その時によって数が変わる商品それぞれに(1)の操作をする
この２点をクリアしたマクロが作りたいのです

皆様のお知恵を貸してください。

ちなみにexcel2003です。

回答No.8

xls88

商品コードの列で、コード入力セル以外は、間違いなく空白セルである
ということなら、turuzouさんのコードで希望通りの動作をします。
商品コード列の最上行セルで、Ctrl＋↓ とキー操作してみてください。
最終行までカーソルが移動するなら、空白セルはないので、すべて破線になります。

数値かどうか判定すればどうでしょうか。
試しに組んでみました。
Sub test1()
　　Dim rng As Range
　　Dim r As Range

　　Set rng = Range("A1", "A" & Cells(Rows.Count, "C").End(xlUp).Row)
　　rng.Resize(, 3).BorderAround LineStyle:=xlContinuous, Weight:=xlThin
　　Set rng = rng.Offset(1).Resize(rng.Count - 1)
　　For Each r In rng
　　　　With r.Resize(, 3).Borders(xlEdgeTop)
　　　　　　If IsNumeric(r.Value) Then
　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　.Weight = xlThin
　　　　　　Else
　　　　　　　　.LineStyle = xlDash
　　　　　　　　.Weight = xlThin
　　　　　　End If
　　　　End With
　　Next
End Sub

＞No3の方も仰る通り、色々調べてやってはみたのですが、なぜか
＞実線が引かれず、うまくいかない原因を見つけられません。
抽象的なことでなく、ご自分でやったこと、書いたコードを提示し、
間違いを指摘してもらうようにすればどうでしょうか。
希望通りの動作をするコードの提供を待っているより、確実に実力UPになると思います。

回答No.7

turuzou

No6　の追記です。
A列の空白セルを空白にさせるには、色々ありますが、
(数式などを削除しても、Ctrl+↑で、コード番号を選択できない場合)
A列を選択 → データ → 区切り位置 → 完了　で、空白セルになると思います。

又は、A1を選択 → フィルタ → オートフィルタ → フィルタの 空白セル を抽出 → 表示されたA列のセルを選択 → Delete　で、空白セルになると思います。

ご自分で作成(修正)された、マクロを提示してみて、A列等の表示が直接入力なのか、数式等で、表示させているのかも、お教え下さい。

回答No.6

turuzou

お疲れ様です。
多分A列は空白に見えていて、数式で空を表示していたり、スペースがあったりしていませんか(本当の空白セルではない)？

提示したマクロは、サンプル画像での、A11　がアクティブセルの時、Ctrl+↑ 押下で、A10(0003)がアクティブにならないと、実線が引かれませんので、確認して下さい。
例えばA列の最下行のセルを選択して、Ctrl+↑ 押下で A1 セルが選択されると、現在のマクロでは正しく動作しません。

A列に数式があり、数式を削除してよいならば、A列の範囲を選択してコピー→形式を選択して貼り付け の 値 で、数式を削除してみてください。

A列の最下行から、Ctrl+↑を繰り返し押下して、コード番号を順々に選択できるようになれば、現在のマクロで実線が引かれます。

又は、
＞空白になり得るのは　特徴の分類/特徴の内容以外の５列
上記の列で、本当の空白セルがある列があるのならば、その列を対象に商品コード別の範囲の上限を捜すことも出来ます。(補助列を作っても良いと思います)

Sheetの変更が出来ないのならば、No.3さんでも書かれているように、1行ずつ、A列を基準に、罫線種を選択しながら、上罫線を引くマクロになると思います。

回答No.5

i_september

こんにちは。
ちょっと式が複雑になりますが、条件付き書式で希望の動きになるかと思います。

A1:商品コード
B1:商品名
C1:商品情報
として、2行目からデータを入力すると仮定します。

A列とB列の2行目には
(1)下部実線書式：数式が
=OR((AND(C2<>"",A3="",C3="")),(AND(C2<>"",A2="",C3<>"",A3<>"")),(AND(C2<>"",A2<>"",C3<>"",A3<>"")))
(2)下部点線書式：
=AND(C2<>"",A3="",C3<>"")
C列2行目には
(1)下部実線書式/右部実線書式：数式が
=OR((AND(C2<>"",A3="",C3="")),(AND(C2<>"",A2="",C3<>"",A3<>"")),(AND(C2<>"",A2<>"",C3<>"",A3<>"")))
(2)下部点線書式/右部実線書式：数式が
=AND(C2<>"",A3="",C3<>"")
と入れて、下の行へ書式の複写をして下さい。
するとほぼ同様の動きになると思います。後は、数式・書式の調整を行ってください。

私も、3行ごとに罫線を引いて入力するなどで使っています。

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

回答No.4

turuzou

No.1です。
＞サンプルです、修正は、ご自分で、お願いします。

＞・・・に変えるだけで大丈夫でしょうか？
最初から実際の範囲を提示するべきですし、確認してから質問してください。

>・・・横線がすべて点線に
A列に例題の様にコード番号が入力されていれば、こちらでは実線が引かれています。

追記
Dim x, y　の下へ
Application.ScreenUpdating = False　

If x <= 2 Then Exit Sub　を削除して
Next x　の下へ
Application.ScreenUpdating = True
としてみても

お礼

＞最初から実際の範囲を提示するべきですし・・・
申し訳ございません。

実際は、
商品コード/発注部署/発注日/納品日/商品名/特徴の分類/特徴の内容
となっており、商品コードが０００１ではなく、５桁で51237とか
85068みたいな数字なんです。

空白になり得るのは
特徴の分類/特徴の内容以外の５列です。

No3の方も仰る通り、色々調べてやってはみたのですが、なぜか
実線が引かれず、うまくいかない原因を見つけられません。

お力をお貸し頂ければ幸いです。

回答No.3

imogasi

こんなの簡単で、丸投げすることも無いでしょう。
（１）まづマクロの記録を取り（罫線を引く位置は置いといて）
罫線、点線を引くなどのコードがどうなるか知る。
上罫線だけを引く場合はどういうコードになるか。
それと多数列に罫線の引き方のコード。
（２）実線を引く場所の特徴を考える。これは質問者が一番良く事情を知っているはず。
例　各行で商品名の列が空白でなかったら、上罫線を実線で引く
（３）点線を引くべき行の特徴を考える。
例　商品列が空白なら、上罫線を点線で引く。
＝＝＝
以上ぐらい考えて、何か疑問があれば質問するようにしないと。
頼りすぎ。　Ｇｏｏｇｌｅででも罫線を引く、点線を引く　ＶＢＡで照会したら。
内容も難しい点はないと思う。

回答No.2

turuzou

No.1です、訂正です。
If x - 1 <= 2 Then Exit Sub
↓
If x <= 2 Then Exit Sub
失礼しました。

回答No.1

turuzou

サンプルです、修正は、ご自分で、お願いします。

Sub keisen()
　Dim x, y
　For x = Cells(65536, 3).End(xlUp).Row To 2 Step -1
　　y = IIf(Cells(x, 1).Value = "", Cells(x, 1).End(xlUp).Row, x)
　　With Range(Cells(y, 1), Cells(x, 3))
　　　.Borders(xlEdgeLeft).LineStyle = xlContinuous
　　　.Borders(xlEdgeTop).LineStyle = xlContinuous
　　　.Borders(xlEdgeBottom).LineStyle = xlContinuous
　　　.Borders(xlEdgeRight).LineStyle = xlContinuous
　　　If x <> y Then .Borders(xlInsideHorizontal).LineStyle = xlDot
　　End With
　　x = y
　　If x - 1 <= 2 Then Exit Sub
　Next x
End Sub

お礼

ありがとうございます！！

列が、例では３列までですが、７列まである場合は、

１）　For x = Cells(65536, 7).End(xlUp).Row To 2 Step -1
２）　With Range(Cells(y, 1), Cells(x, 7))

に変えるだけで大丈夫でしょうか？

これだけでも充分効率化は図れるのですが、作っていただいた
ものですと、横線がすべて点線になっており、商品が変わる毎に
実線で区切りたい場合は、どうすればよろしいのでしょうか？

重ねてお願いいたします。