枠線・・・・

質問

エクセルです

Aに日付が入っています　Bに項目・・・（シート１)

別のシートに
Aに日付け　Bに項目のコード　Cに項目（シート２)

が入っています

シート２に１０件のデータが入っている場合シート１に　AとCだけをコピーしているのですが（もちろん例です)
（シート１のA２＝シート２のA２としている)

そして　表の外側を太線で引いています

が・・・もし５件の場合は自動で５～行目を削除して・・表の外側を太線で引いてほしいのです・・・

また５件から８件に増えたら８行の表の周りを太線にしてほしいのです
（内側は細線です)

意味がわかりづらくてすいません・・・文章では限界があります
分かってくれた方お願いします
ちなみにマクロは素人以下の知識しかないです
（VBはしろうとぐらいかな・・・)

回答No.1

nishi6 · ベストアンサー

シート２のデータをシート１にコピーし、データにあわせた罫線を引きます。シート１に表を作りたいときに実行します。

＞AとCだけをコピーしているのですが（もちろん例です)
下のマクロはA、C列のみのコピーです。実情に合うよう修正してください。参考に、コメントを入れておきました。

ツール→マクロ→Visual Basic Editor でVBE画面に移り、挿入→標準モジュールで 標準モジュールを挿入します。
そのコードウインドウに下記マクロをコピーして貼り付けます。

シートに戻り、ツール→マクロ→マクロで『LineDataCopy』を実行すれば、シート１に目的の表を作ります。
手でシート２のデータをシート１にコピーしたりしません。ご参考に。

ここから
↓
Sub LineDataCopy()
　　Dim ws1 As Worksheet, ws2 As Worksheet 'ワークシート
　　Set ws1 = Worksheets("Sheet1") 'シート1
　　Set ws2 = Worksheets("Sheet2") 'シート2

　　Application.ScreenUpdating = False

　　ws1.Activate
　　Range("A:B").Clear 'シート1のA、B列をクリア(値、罫線)

　　Dim maxRow As Long '最大行
　　'シート2の最大行を求める
　　ws2.Activate: maxRow = ws2.Range("A65536").End(xlUp).Row
　　'シート2のA列をシート1のA列にコピー
　　ws2.Range("A1:A" & maxRow).Copy Destination:=ws1.Range("A1")
　　'シート2のC列をシート1のB列にコピー
　　ws2.Range("C1:C" & maxRow).Copy Destination:=ws1.Range("B1")

　　'罫線を引く範囲を選択
　　ws1.Activate: Range("A1:B" & maxRow).Select
　　'細い罫線を引く
　　LineSet xlEdgeLeft, xlContinuous, xlMedium, xlAutomatic
　　LineSet xlEdgeTop, xlContinuous, xlMedium, xlAutomatic
　　LineSet xlEdgeBottom, xlContinuous, xlMedium, xlAutomatic
　　LineSet xlEdgeRight, xlContinuous, xlMedium, xlAutomatic
　　'太い罫線を引く
　　LineSet xlInsideVertical, xlContinuous, xlThin, xlAutomatic
　　LineSet xlInsideHorizontal, xlContinuous, xlThin, xlAutomatic

　　Range("A1").Select
　　Application.ScreenUpdating = True
End Sub

　　'罫線を引く(Sub)
　　Sub LineSet(Pot, Sty, Wei, Col)
　　　　On Error Resume Next
　　　　With Selection.Borders(Pot)
　　　　　　.LineStyle = Sty
　　　　　　.Weight = Wei
　　　　　　.ColorIndex = Col
　　　　End With
　　End Sub

お礼

回答　ありがとうございます