[[20210924213026]] 『処理したくないシートを飛ばすには(マクロ)』(ココア) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『処理したくないシートを飛ばすには(マクロ)』(ココア)

初めまして。
ネットで探したコードを参考に、複数のシートを「統合」シートにまとめたいのですが、マクロを動かす説明を書いたシートを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


Worksheets(1)は統合シートと書いてありましたね。失礼しました。
ループ前にs=2にしてWorksheets(3)からループさせてみてはいかがですか。
(きまぐれおじさん) 2021/09/24(金) 22:04

きまぐれおじさん様
早速のご回答、ありがとうございます!!
なるほど! s=2にすればいいのですね。
今手元にパソコンないので、帰ったら試して見ます。
ありがとうございます!
(ココア) 2021/09/24(金) 22:46

そこだけではなく、関連する行も修正してください。
(きまぐれおじさん) 2021/09/25(土) 00:13

ありがとうございました。下記2か所変更したらできました。

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


隠居Z様
ご提案ありがとうございます!
ネットで見つけてこれをうまく利用できないかと思いまして…。
ステップインで色々理解しようとしても理解が追いつかない状況です、、
どなたか分かる方いらっしゃいましたら、何卒よろしくお願いします。
(ココア) 2021/09/25(土) 11:03

 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

hatena様
ありがとうございます。
その方がシンプルですね。勉強になります。
この処理に、もし最大行を超えたらさらに統合シート2を作るには…はどのように組み合わせたら良いでしょうか?
(ココア) 2021/09/25(土) 11:29

対象データを配列に格納しているので、現状のコードを少し手直しするだけだと思います。
下記のような感じで。(イメージだけですので細かい修正や動作確認はご自身で)

    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


hatena様
ありがとうございます。
配列に格納や、出力がどのようにやればいいのか現段階では勉強不足で分かっていませんが、
頂いたヒントを元にやってみたいと思います。ありがとうございました。
(ココア) 2021/09/25(土) 13:35

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.