エクセルで複数のシートに罫線を引くマクロを教えてください。
エクセルの表を担当者名でシート分割後、空白セル以外に罫線を引きたいのですが
複数シートに罫線を引くマクロを教えてください。
いくつか参考にさせていただき現状以下の様になっています。
元データというシートにAからGまで項目があります
PJNo.PJ名棟No.棟名取引先名 書類 担当者
1111PJ110棟1取引先1 1 東京
1112PJ211棟2取引先2 2 大阪
1113PJ312棟3取引先3 3 名古屋
Sub 担当別シート作成()
Application.ScreenUpdating = False
For i# = 2 To Worksheets("元データ").Cells(2, 2).End(xlDown).Row
j# = 1
'検索中の人のシートが既にできているかを判断する。
For Each sheet_name In Worksheets
If sheet_name.Name = Worksheets("元データ").Cells(i, 7).Value Then
j = 7
Exit For
End If
Next
'検索中の人のシートがない場合、新規に作成する。
If j = 1 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Worksheets("元データ").Cells(i, 7).Value
For j = 1 To 7
Worksheets(Worksheets.Count).Cells(1, j).Value = Worksheets("元データ").Cells(1, j).Value
Next j
End If
'データのコピー
For j = 7 To 1 Step -1
Worksheets(Worksheets("元データ").Cells(i, 7).Value). _
Cells(Worksheets(Worksheets("元データ").Cells(i, 7).Value). _
Cells(65535, 1).End(xlUp).Row + 1, j).Value = Worksheets("元データ").Cells(i, j).Value
Next j
Next i
'それぞれのシートの列幅を最適化します。
For Each sheet_name In Worksheets
sheet_name.Columns("A:G").AutoFit
Next
'----
Dim c As Range
Range("A1").Select
Set c = Selection.SpecialCells(xlCellTypeLastCell)
Range(Cells(1, "A"), c).Select
(省略)以下罫線を引くマクロ
End Sub
No.6ベストアンサー
- 回答日時:
>罫線は上手く引けましたが、項目の行も1シート作成され、他シートには項目行が入っていません。
ありえません
質問を元にサンプルを作成し、テストしましたが補足のようにはなりません
あるとすれば、質問の表の構成と実際の表の構成が違うのではと思います
こちらでテストした表は
>元データというシートにAからGまで項目があります
A列からG列までが項目で
>For j = 1 To 7
>Worksheets(Worksheets.Count).Cells(1, j).Value = Worksheets("元データ").Cells(1, j).Value
>Next j
ここで項目のある行を1行目と判断できる
>For i# = 2 To Worksheets("元データ").Cells(2, 2).End(xlDown).Row
他のコードから、ここでデータ行の始まりが
2行目からとなっている
質問には明確に書かれていないのでコードから判断しましたが、違うのでしょうか?
上の条件でテストした限りでは、不具合はありませんが?
どのような表で試されたのでしょうか?
補足をお願いします
No.5
- 回答日時:
度々、申し訳ありません
単純な、私のミスです
下記の修正お願いします
>'検索中の人のシートがない場合、新規に作成する。
>If sheet_name Is Nothing Then
>Set sheet_name = Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = .Cells(i, 7).Value
↓ ↓
'検索中の人のシートがない場合、新規に作成する。
If sheet_name Is Nothing Then
Set sheet_name = Worksheets.Add(After:=Worksheets(Worksheets.Count))
sheet_name.Name = .Cells(i, 7).Value
お手数おかけします
No.4
- 回答日時:
申し訳ありません
下記の修正をお願いします
> :
>c.Borders(xlEdgeRight).Weight = xlThin
>Next
>Next i
> :
を
:
c.Borders(xlEdgeRight).Weight = xlThin
End If
Next
Next i
:
の様に「End If」が抜けていました
お手数おかけします
No.3
- 回答日時:
こんな感じで?
Sub 担当別シート作成()
Dim i
Dim j
Dim sheet_name As Worksheet
Dim c As Range
Application.ScreenUpdating = False
With Worksheets("元データ")
For i = 2 To .Cells(2, 2).End(xlDown).Row
'検索中の人のシートが既にできているかを判断する。
For Each sheet_name In Worksheets
If sheet_name.Name = .Cells(i, 7).Value Then Exit For
Next
'検索中の人のシートがない場合、新規に作成する。
If sheet_name Is Nothing Then
Set sheet_name = Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = .Cells(i, 7).Value
.Cells(1, 1).Resize(1, 7).Copy sheet_name.Cells(1, 1)
End If
'データのコピー
.Cells(i, 1).Resize(1, 7).Copy sheet_name.Cells(65535, 1).End(xlUp).Offset(1)
'それぞれのシートの列幅を最適化します。
sheet_name.Columns("A:G").AutoFit
'以下罫線を引くマクロ
For Each c In sheet_name.Range("A1", sheet_name.Cells.SpecialCells(xlCellTypeLastCell))
If c.Value <> "" Then
c.Borders(xlEdgeLeft).Weight = xlThin
c.Borders(xlEdgeTop).Weight = xlThin
c.Borders(xlEdgeBottom).Weight = xlThin
c.Borders(xlEdgeRight).Weight = xlThin
Next
Next i
End With
Application.ScreenUpdating = True
End Sub
参考まで
この回答への補足
とてもシンプルになるんですね。
初心者ですのでとても参考になります。
ありがとうございます。
早速試してみたのですが
'以下罫線を引くマクロの
Nextでエラーがでて止まってしまいました。
素人なりに色々とやってみましたが自力では無理なようで
再度助けていただけたらと思います。
宜しくお願いします。
No.2
- 回答日時:
No.1です!
たびたびごめんなさい。
投稿した後もう一度質問文を読み返してみると
>エクセルで複数のシートに罫線を・・・
とありましたので、再び顔を出してしまいました。
そして、前回の方法も少し改善してみました。
全てのSheetのA~G列という前提です。
画面左下のSheet1を開いた状態でShiftキーを押しながら最後のSheetタブをクリックします。
これで全てのSheetが作業グループ化されましたので
A~G列全てを範囲指定 → 条件付書式 → 数式が → 数式欄に
=A1<>"" として 好みの罫線を選択 → OK
これで完了です。
最後にSheetタブ上で右クリックし、作業グループを解除してください。
前回の方法では数式等が入っていて、空白であっても罫線が引かれたと思いますが、
今回の方法だと数式等が入力されていても問題ないと思います。
どうも何度も失礼しました。m(__)m
とても丁寧に説明していただきありがとうございます。
やってみましたが先に提案していただいた0と等しくない方法で上手くいきました。
=A1<>""の方はA1から書式のコピーが必要なようで少し手間がかかりました。
マクロが使えない場合はこちらで作業させていただきます。
ありがとうございました。
No.1
- 回答日時:
こんばんは!
VBAでないので参考にならなかったら無視してください。
単純に条件付書式を利用してはダメですか?
当方使用のExcel2003の場合ですが、
A~G列全てを範囲指定 → 書式 → 条件付書式 → 「セルの値が」 → 「次の値に等しくない」 → 「0」を入力 → 書式 → 罫線タブで好みの罫線を選択 → OK
これでA~G列の空白以外のセルに罫線が表示できるはずです。
尚、数値が入力され「0」の場合は条件に当てはまりませんので気をつけてください。
以上、長々と書きましたが
的外れなら読み流してくださいね。m(__)m
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
- Visual Basic(VBA) 日付を重複させずに数えたい 4 2022/12/04 16:26
- Visual Basic(VBA) 他のシートからコピーする下記マクロで貼付け位置をWorksheets(1).Range("A3")の 8 2023/01/30 18:48
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたい 6 2023/01/23 12:00
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの条件付き書式設定の太い...
-
Excelの外枠太罫線を2~3倍さ...
-
罫線の色を薄くしたい
-
<EXCEL>ページ最後の行の罫線...
-
エクセルで罫線も一緒に並び替...
-
パワーポイントで、表の一部を...
-
罫線が引かれているセルの個数...
-
決まった罫線のなかで、文章入...
-
エクセルで文字を入力すると罫...
-
excel2003 罫線だけを保護したい
-
エクセル 入力されていない線...
-
【エクセル】謎の枠線の消し方
-
EXCELで、下線の太さを変...
-
Excel カメラ機能でセル...
-
エクセルのアンダーラインについて
-
エクセルExcel 「/」セルの斜...
-
エクセルの下線
-
勝手に背景に色が付いて困っ...
-
エクセル
-
Excel VBA 空白セル以外のセル...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの条件付き書式設定の太い...
-
Excelの外枠太罫線を2~3倍さ...
-
excel2003 罫線だけを保護したい
-
勝手に背景に色が付いて困っ...
-
EXCELで、下線の太さを変...
-
【エクセル】謎の枠線の消し方
-
エクセルで文字を入力すると罫...
-
罫線の色を薄くしたい
-
エクセルで罫線も一緒に並び替...
-
パワーポイントで、表の一部を...
-
決まった罫線のなかで、文章入...
-
エクセル
-
罫線が引かれているセルの個数...
-
エクセルのアンダーラインについて
-
EXCELのオートフィルタで罫線が...
-
エクセル 入力されていない線...
-
Wordで表のセル幅を超えたら次...
-
エクセル表の罫線(縦)が消せ...
-
エクセルの罫線を固定させる方...
-
エクセルExcel 「/」セルの斜...
おすすめ情報