[[20100216140022]]　『複数シートで、項目ごとに罫線を引きたい VBA』（肩こり）　ページの最後に飛ぶ

 『複数シートで、項目ごとに罫線を引きたい VBA』（肩こり）

 このような表があるのですが、この中で種別（10.20…）の区切りごとに
 横罫線を引くVBAを教えてください。種別はその都度数が変わります。
 10がない日もあれば10個くらい入る日もあります。単位は10単位づつで
 990くらいまでです。また同じようなシートが続いているので複数シートに
 適応したいのであわせてお願いします。

 種別 日付     ｵｰﾀﾞｰ	納入	品番	履歴	名前	台数
 10   20100215 M7974625	AB	152	00	田中	27
 10   20100215 M7974626	CD	132	00	鈴木	43
 10   20100215 M7974627	AC	145	00	佐藤	54
 20   20100215 M7974639	AB	166	00	鈴木	14
 20   20100215 M7974640	AB	170	00	斉藤	8
 30   20100215 M7974628	AC	166	00	田中	6
 30   20100215 M7974629	AD	125	00	田中	53
 40   20100215 M7974630	CD	134	00	山田	21
 40   20100215 M7974631	CB	156	00	斉藤	13

 WindowsXP
 Excel2003

 VBAでも出来ますが条件付書式ではダメですか？
 A1:H10に上記の表があるとして
 A1:H10を範囲選択して条件付書式で数式が「=$A1<>$A2」
 で罫線で下線を設定で出来ると思います。
 （ｍｏｍｏ）

 ちなみに、マクロならこんな感じ

  Sub test()
  Dim i As Long
  For i = 2 To Range("A1").End(xlDown).Row
    If Range("A" & i).Value <> Range("A" & i + 1).Value Then
      Rows(i).Columns("A:H").Borders(xlEdgeBottom).LineStyle = xlContinuous
    End If
  Next i
  End Sub

 （ｍｏｍｏ）

 ｍｏｍｏさま。ありがとうございます。2つの方法でできました。
 ちなみにこのデータはシート2～8位まで続いているのですが、
 マクロで他のシートでも同じように罫線を引く場合を
 お教え願いたいです。宜しくお願いします。

（肩こり）

 そのシートをアクティブにすれば良いのでは？

 老婆心ながら・・・

 Cells.Borders.LyneStyle = xlNone

 は要りませんか・・・？

 (ROUGE)

 ROUGEさんのご意見を反映したうえでシート２～８（Index番号ですよね？）でしたら

  Sub test()
  Dim i As Long, s As Long
  For s = 2 To 8
    With Sheets(s)
      .Cells.Borders.LyneStyle = xlNone
      For i = 2 To .Range("A1").End(xlDown).Row
        If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
          .Rows(i).Columns("A:H").Borders(xlEdgeBottom).LineStyle = xlContinuous
        End If
      Next i
    End With
  Next s
  End Sub

 ってな感じでしょうか
 （ｍｏｍｏ）

 ROUGEさん、ｍｏｍｏさんありがとうございます。
 .Cells.Borders.LyneStyle = xlNone
 ここが原因で止まってしまいます。なしにすると
 最後まで行くのですが^^;
 （肩こり）

 ・・・orz
 スペルミスです。
 LineStyle
  ~ここが...(><)
 (ROUGE)

 あ・・・つい面倒でコピペさせてもらってチェックしてませんでした
 すみませ～ん　＞＜
 （ｍｏｍｏ）

 罫線を描くシート（2～8）の中にデータが入っていないシートが
 ある場合（データがないシートが発生するのはまちまちです）
 If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
 上記のここで止まってしまうのですが、教えてください。
 （肩こり）

 これから出張なので未テストですが、たぶんこれで。

  Sub test()
  Dim i As Long, s As Long
  For s = 2 To 8
    With Sheets(s)
      .Cells.Borders.LineStyle = xlNone
      For i = 2 To .Range("A1").End(xlDown).Row
        If .Range("A" & i).Value <> "" And .Range("A" & i + 1).Value <> "" Then
          If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
            .Rows(i).Columns("A:H").Borders(xlEdgeBottom).LineStyle = xlContinuous
          End If
        End If
      Next i
    End With
  Next s
  End Sub

 （ｍｏｍｏ）

 こんにちは。
 試したのですが、今度はここで↓

 If .Range("A" & i).Value <> "" And .Range("A" & i + 1).Value <> "" Then

 止まってしまいます。加えて、元のマクロでは
 一番下の数値の下にも罫線が引かれたのに対し、
 新しいものは、一番下の罫線が引かれなくなって
 しまいました。宜しくお願いします;;
 （肩こり）

 状況が良くわかりませんが、これで対応できますか？
 データの無い状況というのがどういう状態なのか不明です。

  Sub test()
  Dim i As Long, s As Long
  For s = 2 To 8
    With Sheets(s)
      .Cells.Borders.LineStyle = xlNone
      For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
          .Rows(i).Columns("A:H").Borders(xlEdgeBottom).LineStyle = xlContinuous
        End If
      Next i
    End With
  Next s
  End Sub

 （ｍｏｍｏ）

 ｍｏｍｏさんありがとうございます。
 データのない状況とは、1番上のデータがシート2～8まで
 入っている場合もあれば、シート3（どのシートかは決まっていない）
 だけ空白だったりするということです。説明不足で申し訳ありませんm(_ _)m

 一番下の罫線も含め希望通りになりました。
 ありがとうございました。

 （肩こり）

コメント返信：

[ 一覧(最新更新順) ]

[[20100216140022]] 『複数シートで、項目ごとに罫線を引きたい VBA』（肩こり） ページの最後に飛ぶ

[[20100216140022]]　『複数シートで、項目ごとに罫線を引きたい VBA』（肩こり）　ページの最後に飛ぶ