[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『処理したくないシートを飛ばすには(マクロ)』(ココア)
初めまして。
ネットで探したコードを参考に、複数のシートを「統合」シートにまとめたいのですが、マクロを動かす説明を書いたシートを1番先頭シートに入れていると、正しく合体されません。飛ばしたいシートの名称は「マクロ手順」シートです。
仮に「マクロ手順」シートを1番後ろのシートに持ってくると、動く事はうごくのですが、マクロ手順シートの内容も合体されてしまいます。
先頭シートに置いたまま、正しく動かすにはどのようにやれば良いでしょうか?
下記のどこかに、
If targetSheet.Name <> "マクロ手順" Then …のような感じで飛ばせないでしょうか?
Sub シート統合()
Dim i As Long
Dim r As Long
Dim s As Long
Dim Sh As Worksheet
Dim MaxRow As Long
Dim MaxCol As Long
Dim MyArray As Variant
Dim JoinSh As Worksheet
Set JoinSh = Worksheets("統合")
JoinSh.Cells.Delete
s = 1 '最大行を超えた場合次の統合シートを作成するための番号
For i = s + 1 To Worksheets.Count 'シートを統合シートの次〜末尾までループ
With Worksheets(i) If i = 2 Then r = 1 '最初だけ項目も取得 Else r = 2 '最初以外は2行目から取得 End If
MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '1列目で最終行を取得 MaxCol = .Cells(1, Columns.Count).End(xlToLeft).Column '1行目で最終列を取得 MyArray = Range(.Cells(r, 1), .Cells(MaxRow, MaxCol)) 'A1〜データ末尾まで配列に格納 End With With JoinSh '統合シート MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理
s = s + 1 '統合シートの番号を加算 Worksheets.Add Before:=Worksheets(s) '新規に統合シートを追加 ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加
Set JoinSh = ActiveSheet '統合シートを変数に格納 MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 End If
If .Cells(1, 1) = "" Then '最初だけ1行目から貼り付け Range(.Cells(1, 1), .Cells(UBound(MyArray), MaxCol)) = MyArray Else '最初以外は最終行の次に貼り付け Range(.Cells(MaxRow + 1, 1), .Cells(MaxRow + UBound(MyArray), MaxCol)) = MyArray End If End With Next i End Sub
< 使用 Excel:Excel2016、使用 OS:Windows10 >
If i <> Worksheets("マクロ手順").Index Then
End If
こんなところでしょうか。
それとi=2からのループになっているので他にも未説明の要素が絡んでいるかもしれません。
そのブックのWorksheets(1)は何ですか?
(きまぐれおじさん) 2021/09/24(金) 21:57
s = 2 ←1から2に修正
For i = s + 1 To Worksheets.Count 'シートを統合シートの次〜末尾までループ
With Worksheets(i)
If i = 3 Then ←2から3に修正
但し、もし統合シートの最大行数を超えたら、統合シートの次のシートを作り…
となっている部分がうまく処理されません。
気づかなかったのですが、これについては、シートの場所をどうするか以前の問題でこのコードでは正しく処理されないようなのですが。
どなたか分かりますでしょうか?
統合シートに順番に各シートの値を貼り付けていって、仮に5シート目に8万行のデータが入っていて、そこでシートの行数が足りなくなるとすると、5シートめの項目行とプラス1行貼り付けた所までしか貼りつかずに、統合シートの続きのシートも生成されません。
No. 個数
1 10
2 10
3 10
4 10
・
・
・
・
・
・↓ここから5シート目に入るとして…
No. 個数
1 5
(ココア) 2021/09/25(土) 08:13
おはようございます ^^ シートをループ中にシートの数をふやすのですかぁ〜^^; すごいまくろですね。多分出来ない事はないのでしょうが。 ややこしければ、統合分は、どんどん、テキストか書式が面倒なら 別ブックに書き出して、あとから、書き分ける[シート別]と シンプルなのはシンプルかも。←わかりやすい、けど手間が増えます 的外れでしたらお許しを。m(__)m そんなめんどぉな事出来るか!と、お思いでしたら、 一案で、 1.ループを止めるシートを決めておきそこから、右へ処理対象シートを並べて置く 2.ループは一番右端から基準のシートまで 3.増加分は右端へ増やしていく。?? とか。。。実験していません。。。だめかも(@_@;) m(__)m
他の回答者様の
アドバイスをお待ちください。
(隠居Z) 2021/09/25(土) 09:08
For i = s + 1 To Worksheets.Count
というようにループさせてインデックスを基準に対象シートを決めていたら、
途中でシートが追加されたら、
Worksheets.Countが増えちゃうし、後のシートのインデックスは一つずれるし、・・
というようなことを考えていたら、悩ましいですよね。
まずは、ループで、処理対象のシートを配列かコレクションに格納して、
そのシートに対して処理をするようにすれば悩まずにすむと思います。
コレクションに格納するコード例
Dim ws As Worksheet, colWs As New Collection
For Each ws In Worksheets If ws.Name <> "マクロ手順" And ws.Name <> "統合" Then colWs.Add ws End If Next
For Each ws In colWs
With ws
'wsを対象にシート統合処理
End With
Next (hatena) 2021/09/25(土) 11:21
Dim ws As Worksheet, colWs As New Collection For Each ws In Worksheets If ws.Name <> "マクロ手順" And ws.Name <> "統合" Then colWs.Add ws End If Next
For Each ws In colWs With ws
'wsのデータを配列に格納
End With
With JoinSh '統合シート MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 If MaxRow + UBound(MyArray) > Rows.Count Then '最大行を超える場合の処理 s = s + 1 '統合シートの番号を加算 Worksheets.Add After:=JoinSh '新規に統合シートを追加 ActiveSheet.Name = "統合" & s '名前が同じにならないように番号を追加 Set JoinSh = ActiveSheet '統合シートを変数に格納 MaxRow = JoinSh.Cells(Rows.Count, 1).End(xlUp).Row '統合シートの1列目で最終行取得 End If
'配列データを統合シートに出力
End With
Next
(hatena) 2021/09/25(土) 12:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.