ついに夏本番!さぁ、家族でキャンプに行くぞ! >>

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

商品コード  商品名  商品の特徴
0001   商品1   商品1の特徴1
               商品1の特徴2
0002   商品2   商品2の特徴1
               商品2の特徴2
               商品2の特徴3
      ・
      ・
      ・

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

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

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

ちなみにexcel2003です。

「excelで罫線を引くマクロを教えてくだ」の質問画像

このQ&Aに関連する最新のQ&A

A 回答 (8件)

商品コードの列で、コード入力セル以外は、間違いなく空白セルである


ということなら、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になると思います。
    • good
    • 0

No6 の追記です。


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

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

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

お疲れ様です。


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

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

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

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

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

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

こんにちは。


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

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行ごとに罫線を引いて入力するなどで使っています。
※添付画像が削除されました。
    • good
    • 0

No.1です。


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

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

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

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

If x <= 2 Then Exit Sub を削除して
Next x の下へ
Application.ScreenUpdating = True
としてみても
    • good
    • 0
この回答へのお礼

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

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

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

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

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

お礼日時:2009/05/26 23:10

こんなの簡単で、丸投げすることも無いでしょう。


(1)まづマクロの記録を取り(罫線を引く位置は置いといて)
罫線、点線を引くなどのコードがどうなるか知る。
上罫線だけを引く場合はどういうコードになるか。
それと多数列に罫線の引き方のコード。
(2)実線を引く場所の特徴を考える。これは質問者が一番良く事情を知っているはず。
例 各行で商品名の列が空白でなかったら、上罫線を実線で引く
(3)点線を引くべき行の特徴を考える。
例 商品列が空白なら、上罫線を点線で引く。
===
以上ぐらい考えて、何か疑問があれば質問するようにしないと。
頼りすぎ。 Googleででも罫線を引く、点線を引く VBAで照会したら。
内容も難しい点はないと思う。
    • good
    • 0

No.1です、訂正です。


If x - 1 <= 2 Then Exit Sub

If x <= 2 Then Exit Sub
失礼しました。
    • good
    • 0

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



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
    • good
    • 0
この回答へのお礼

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

列が、例では3列までですが、7列まである場合は、

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

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

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

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

お礼日時:2009/05/26 11:22

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QExcel VBAで罫線を引くマクロを書きたい

Excel VBAで罫線を引くマクロを書きたいと思っています。
で、文末のコードを書きました。(というかマクロ記録したものほぼそのもの)
これだとある程度動くのですが、内側線が無いような範囲を選択した場合にはエラーになってしまいます。
内側の線を引く際にIF文をかまさなければならないように思うのですが、イマイチわかりません。
この点について教えてください。
また、コードが冗長であるようにも思えます。もう少しスマートな書き方があればあわせて教えてください。
よろしくお願いします。

Sub 枠線基本()

' 周囲
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

' 内側
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

End Sub

Excel VBAで罫線を引くマクロを書きたいと思っています。
で、文末のコードを書きました。(というかマクロ記録したものほぼそのもの)
これだとある程度動くのですが、内側線が無いような範囲を選択した場合にはエラーになってしまいます。
内側の線を引く際にIF文をかまさなければならないように思うのですが、イマイチわかりません。
この点について教えてください。
また、コードが冗長であるようにも思えます。もう少しスマートな書き方があればあわせて教えてください。
よろしくお願いします。

Sub ...続きを読む

Aベストアンサー

選択範囲の行数が2以上なら内側の水平線を、列数が2以上なら垂直線を引くようにしてあげれば良いのでは?
と思ったら、複数エリアを選択している時にちょいと面倒が・・・
(そんな場合を、想定しなくてもいいのかも知れませんが)

ということで、こんなのでどうでしょうか?
Sub test()
Dim rng As Range
Dim i As Integer

For Each rng In Selection.Areas
'//全部の罫線(内・外とも)
 rng.Borders.LineStyle = xlContinuous
 rng.Borders.Weight = xlThin
 rng.Borders.ColorIndex = xlAutomatic

'//内側の罫線
 For i = 11 To 12
  If (i = 11 And rng.Columns.Count > 1) Or (i = 12 And rng.Rows.Count > 1) Then
   rng.Borders(i).LineStyle = xlContinuous
   rng.Borders(i).Weight = xlHairline
   rng.Borders(i).ColorIndex = xlAutomatic
  End If
 Next i
Next rng
End Sub

複数エリアを想定しなければ、外側のループは不要です。

選択範囲の行数が2以上なら内側の水平線を、列数が2以上なら垂直線を引くようにしてあげれば良いのでは?
と思ったら、複数エリアを選択している時にちょいと面倒が・・・
(そんな場合を、想定しなくてもいいのかも知れませんが)

ということで、こんなのでどうでしょうか?
Sub test()
Dim rng As Range
Dim i As Integer

For Each rng In Selection.Areas
'//全部の罫線(内・外とも)
 rng.Borders.LineStyle = xlContinuous
 rng.Borders.Weight = xlThin
 rng.Borders.ColorIndex = xlAut...続きを読む


人気Q&Aランキング