[[20220525093152]] 『VBAで特定シート名間の選択』(VBABAA) ページの最後に飛ぶ

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

 

『VBAで特定シート名間の選択』(VBABAA)

シートが以下のように並んでいます。

"aaa"  "AAA"   "bbb"   "ccc" ・・・・  "ZZZ"

「AAA」と「ZZZ」の名前は固定ですが、「AAA」「ZZZ」間に挟まれたシートの
数とシートの名前は変わる可能性があります。

とにかく「AAA」から「ZZZ」間のシートを新しいブックに抜き出したいの
ですが、VBAでどのようにすれば「AAA」「ZZZ」間を選択させられるのか
イメージが沸きません。
選択さえできれば後のコードは書けそうなのですが。。

どういう方法があるか、日本語でざっと教えてもらえないでしょうか。
コード自体は自分で試行錯誤したいと思っています。

< 使用 Excel:Excel2010、使用 OS:Windows10 >


 全シートを左から順番に総当たりして
  AAAシートでフラグ立て
  フラグ立ってたらシート名を収集
  ZZZシートで総当たり中断

 収集数がゼロだったら終わる
 収集したシート達を新しいブックに抜き出す
                                          ...という流れかしら?

(白茶) 2022/05/25(水) 10:13


ひとつずつコピーするのが間違いないと思います。
Worksheets("●●").Index で左から何番目かが分かりますから、
あとは、Worksheets(k)という指定方法で、
何番から何番までのシートをFor.. Nextで繰り返し処理をすればいいのでは?
(γ) 2022/05/25(水) 10:32

 まとめて選択してコピーするならこうですか。
 Sub test()
     Dim k As Long, n As Long

     n = Worksheets("AAA").Index + 1
     Worksheets(n).Select
     For k = n + 1 To Worksheets("ZZZ").Index - 1
         Worksheets(k).Select False
     Next
     ActiveWindow.SelectedSheets.Copy
 End Sub
(γ) 2022/05/25(水) 10:56

(白茶)さん
ちょっと考え中です。
ありがとうございました。

(Y)さん
すみません、書き忘れがありました。
実は別シート参照の計算式を入れてて、元データの数式は残しつつ抜き出した先で
数値に変えようと思っているので1シートずつコピーはダメなのです。ダメですよね?

(VBABAA) 2022/05/25(水) 11:07


 案の1 
 1 For Each  〜 Nextで、全シートの名前を取得
 2 シート名が「AAA」「ZZZ」以外だったらコピー処理

 案の2
 1 ブックを丸ごとコピー
 2 コピーしたブックから「AAA」「ZZZ」を削除

 目的が「AAA」「ZZZ」を除いたブックを新たに作りたいというのであれば、
 案の2の方が楽かな?

(jjj) 2022/05/25(水) 11:17


実は別シート参照の計算式を入れてて、元データの数式は残しつつ抜き出した先で 数値に変えようと思っているので1シートずつコピーはダメなのです。ダメですよね?

コピーしてから、値に変換してもいいでしょう。
その場合、1シートずつ値化する必要はあると思います。

(hatena) 2022/05/25(水) 11:50


コピーの後に下記のようなコードを追加すればいいでしょう。

     ActiveWindow.SelectedSheets.Copy

     Dim ws As Worksheet
     For Each ws In ActiveWorkbook.Worksheets
        ws.UsedRange.Value = ws.UsedRange.Value
     Next
(hatena) 2022/05/25(水) 12:05

■1
>「AAA」から「ZZZ」間のシートを新しいブックに抜き出したい
これは、「AAA」と「ZZZ」は対象にならないという理解でよいのでしょうか?

■2
>どういう方法があるか、日本語でざっと教えてもらえないでしょうか。
上記がYESということを前提にしますが、ざっというのは難しいので、疑似コードにしてみました。

    まくろすたーと       
        はじまり = AAAシートのインデックス番号
        おわり = ZZZシートのインデックス番号

        もしも、「おわり - はじまり = 1」なら、処理中止

        AAAシートの次のシートを選択
        はじまり + 1 〜 おわり - 1 を繰り返し処理
            引数ReplaceをFalseにして、○番目のシートを選択
        繰り返し処理終了

        アクティブウインドウのうち、選択されているシートを(新規ブックに)コピー
    まくろおわり

(もこな2 ) 2022/05/25(水) 12:09


>すみません、書き忘れがありました。
>実は別シート参照の計算式を入れてて、元データの数式は残しつつ抜き出した先で
>数値に変えようと思っているので1シートずつコピーはダメなのです。ダメですよね?
なぜダメなのかわからない。
元のブックを参照する式になるだけで値が変わるわけもないでしょ?
そもそも、Indexを使ってという回答を無視する理由もわからない。
説明していただきたい。
(γ) 2022/05/25(水) 12:32

Option Explicit

Sub test()

    Const sKey As String = "AAA"
    Const eKey As String = "ZZZ"
    Dim ws As Worksheet
    Dim flg As Boolean

    '自ブックのシートの集まりを新しいブックにコピー
    ThisWorkbook.Sheets.Copy

    '新しいブック(最後に開かれたブック)のシートの集まりの各要素を巡回
    For Each ws In Workbooks(Workbooks.Count).Worksheets
        '始まりのキーワードのシート名ならば目印を付ける
        If ws.Name = sKey Then flg = True
        '終わりのキーワードのシート名ならば目印を消す
        If ws.Name = eKey Then flg = False

        'もし、目印がついていたら、
        If flg Then
            'シート上の使っているセル範囲の値を同じセル範囲に入れなおす。(数式が消える)
            With ws.UsedRange
                .Value = .Value
            End With
        'そうでなければ、
        Else
            'シートを削除
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next
End Sub

こんな感じ?
「フラグ」という言葉を聞いたことないですか?
ちょっとネットで調べてみるといいと思います。

※キーワードと同じ名前のシートの次とか一つ手前とかだと、
もうひとひねり必要です。
その辺をはっきりさせましょう。
(まっつわん) 2022/05/25(水) 17:38


解決済かもしれませんが、無駄に元ブックからデータを転記するようにしてみました。
研究用として提示します。

    Sub 研究用()
        Dim i As Long, c As Long
        Dim buf() As String
        Dim SH As Worksheet

        Stop

        With ThisWorkbook
            For i = .Worksheets("AAA").Index + 1 To .Worksheets("ZZZ").Index - 1
                ReDim Preserve buf(c)
                buf(c) = .Worksheets(i).Name
                c = c + 1
            Next i

            If c = 0 Then
                MsgBox "対象シートなし"
                Exit Sub
            Else
                .Worksheets(buf).Copy
            End If

            For Each SH In Workbooks(Workbooks.Count).Worksheets
                SH.UsedRange.Value = .Worksheets(SH.Name).UsedRange.Value
            Next

        End With
    End Sub

(もこな2) 2022/05/26(木) 07:26


コメント返信:

[ 一覧(最新更新順) ]


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