[[20151125132912]]　『複数のブックを開いた状態で指定した文字を含むブ』（メロウ）　ページの最後に飛ぶ

『複数のブックを開いた状態で指定した文字を含むブックをアクティブにする』（メロウ）

いつもお世話になっております。よろしくお願いします。

今回は、複数のブックを開いている時、指定した文字を含むブックをアクティブにする方法を教えてほしいです。

下記のようなコードを組みました。
内容は、今開いているブックじゃないブックを選択し、そのブックの各シートの指定セルを判定して、処理をする、というようなものです。

問題は、３つ以上ブックを開いた時、希望するブックをアクティブに出来ないところです。
ブック名は絶対変わらない文字列「小スケール」＆数字（可変）なので、「小スケール」が入るブックを指定したいです。

どなたかご教授よろしくお願いします。
また、コード読んでいただける方いましたら、この方が良い！等のアドバイス等頂けると嬉しいです。

Sub test()

Dim wb As Workbook

For Each wb In Workbooks

  If wb.Name <> ActiveWorkbook.Name Then
     wb.Activate
     Exit For
     End If
Next wb

GO = MsgBox(ActiveWorkbook.Name & " で完了分を初期化します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbQuestion)
If GO = vbOK Then

    Dim r As Long
    For r = 4 To Worksheets.Count

    If Worksheets(r).Range("K3") > 0 Then
    Worksheets(153).UsedRange.Copy Worksheets(r).Range("A1")
    Excel.Application.CutCopyMode = False
    On Error Resume Next
    Worksheets(r).Cells.SpecialCells(xlCellTypeComments).ClearComments
    End If
    Next r
    MsgBox "完了分の初期化が完了しました"
Else
MsgBox "キャンセルされました", vbExclamation
End If

End Sub

＜使用 Excel：Excel2007、使用 OS：WindowsXP ＞

こんにちは

Sub test()

    Dim wb As Workbook
    Dim r  As Long
    For Each wb In Workbooks
        If wb.Name <> ActiveWorkbook.Name And wb.Name Like "小スケール*" Then
            wb.Activate
            GO = MsgBox( _
                ActiveWorkbook.Name & " で完了分を初期化します。" & _
                        vbCrLf & "よろしいですか？", vbOKCancel + vbQuestion)
            If GO = vbOK Then
                For r = 4 To wb.Worksheets.Count
                    If wb.Worksheets(r).Range("K3") > 0 Then
                        ThisWorkbook.Worksheets(153).UsedRange.Copy _
                            wb.Worksheets(r).Range("A1")
                        On Error Resume Next
                        wb.Worksheets(r).Cells _
                            .SpecialCells(xlCellTypeComments).ClearComments
                        On Error GoTo 0
                    End If
                Next r
                MsgBox "完了分の初期化が完了しました"
            Else
                MsgBox "キャンセルされました", vbExclamation
            End If
        End If
    Next wb
End Sub

こういう事でしょうか？

（ウッシ） 2015/11/25(水) 13:52

 カブリましたが。
 目的のブックをアクティブにするところまでのコードです。

 Sub Test()
    Dim wb As Workbook
    Dim targetWb As Workbook

    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name And wb.Name Like "小スケール*" Then
            Set targetWb = wb
            Exit For
        End If
    Next

    If targetWb Is Nothing Then
        MsgBox "目的のブックは開かれていません"
    Else
        targetWb.Activate
        'ここで必要な処理を
    End If

 End Sub

（β） 2015/11/25(水) 13:57

 なお、この処理は、当該ブックをアクティブにしなくても実行できますよ。
 実行結果を最後に目で見せるためにアクティブにするということであればわかりますが。

（β） 2015/11/25(水) 14:30

ウッシ様
ありがとうございます！
ですが、ご提示いただいたコード実行しましたら、何も起こらず終了してしまいました…。
目的ブックは開いていたのですが…。

β様
ありがとございます！
まさに希望通りです！！

この作業はアクティブにしなくても出来るのですか？！
私が書いたコードではたぶんアクティブになってないとダメだと思うのですが、
お時間あればどのように書いたら良いか教えて頂きたいです！
実行結果は、最後にメッセージで出れば良いので大丈夫です。

よろしくお願いします。

（メロウ） 2015/11/25(水) 14:48

こんにちは

「小スケール」＆数字のブックをアクティブにして実行してしまったのでは？

Sub test()

    Dim wb As Workbook
    Dim r  As Long
    Dim GO As Variant
    For Each wb In Workbooks
        If wb.Name Like "小スケール*" Then
            GO = MsgBox( _
                ActiveWorkbook.Name & " で完了分を初期化します。" & _
                        vbCrLf & "よろしいですか？", vbOKCancel + vbQuestion)
            If GO = vbOK Then
                For r = 4 To wb.Worksheets.Count
                    If wb.Worksheets(r).Range("K3") > 0 Then
                        ThisWorkbook.Worksheets(153).UsedRange.Copy _
                            wb.Sheets(r).Range("A1")
                        On Error Resume Next
                        wb.Worksheets(r).Cells _
                            .SpecialCells(xlCellTypeComments).ClearComments
                        On Error GoTo 0
                    End If
                Next r
                MsgBox "完了分の初期化が完了しました"
            Else
                MsgBox "キャンセルされました", vbExclamation
            End If
        End If
    Next wb
End Sub

ついでですが、マクロブックには153枚以上のシートがあるのですか？

（ウッシ） 2015/11/25(水) 15:15

ウッシ様

もう一度試しましたが、別のブックがアクティブだと、そのブックが対象になりました。

マクロブックにも、小スケールブックにも、153以上のシートを持っています。

ちなみに、
ThisWorkbook.Worksheets(153).UsedRange.Copy _

                            wb.Sheets(r).Range("A1")
この箇所ですが、
ThisWorkbook　ではなく、wb.Worksheets(153).UsedRange.Copy wb.Sheets(r).Range("A1")
となります。

マクロブックは、やり方を明記したブックで、作業は小スケールブック内で行われます。
お時間さいて頂き、ありがとうございます！

（メロウ） 2015/11/25(水) 16:01

 >>この作業はアクティブにしなくても出来るのですか？！

 シート処理コードにブック修飾をしてやれば、そのブックがアクティブでなくても処理可能です。
 ブックやシートやセルをアクティブにして処理するコードを【状況依存コード】と呼んだりしますが
 そういうコードは保守性に劣るもので、基本的には避けるべきです。

 なお、153枚以上のシート！　ウッシさんと同じく、ぎょっとしています。
 これはこれで、問題がある構成かもしれません。
 また、153枚目と固定で扱うのも、う～ん　と思いますね。
 同じブックに存在させるとしても、シート名を決めておいて（"テンプレート"とか）あつかうべきだと思いますね。
 また、その 153枚目のブックは、処理の対象外にしなければいけないのでは？
 (処理対象になっても結果オーライでしょうけど）

 いずれにしても、現行の構えで２例ほど。
 書いただけで動かしてはいませんので不具合あれば御容赦。

 Sub Test1()
    Dim wb As Workbook
    Dim targetWb As Workbook
    Dim r As Long

    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name And wb.Name Like "小スケール*" Then
            Set targetWb = wb
            Exit For
        End If
    Next

    If targetWb Is Nothing Then
        MsgBox "目的のブックは開かれていません"
    Else
        'ここで目的のブックを処理
        If MsgBox(targetWb.Name & " で完了分を初期化します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbQuestion) = vbOK Then
            For r = 4 To targetWb.Worksheets.Count
                If targetWb.Worksheets(r).Range("K3") > 0 Then
                    targetWb.Worksheets(153).UsedRange.Copy targetWb.Worksheets(r).Range("A1")
                    On Error Resume Next
                    targetWb.Worksheets(r).Cells.SpecialCells(xlCellTypeComments).ClearComments
                    On Error GoTo 0
                End If
            Next r
            MsgBox "完了分の初期化が完了しました"
        Else
            MsgBox "キャンセルされました", vbExclamation
        End If
    End If

 End Sub

 Sub Test2()
    Dim wb As Workbook
    Dim targetWb As Workbook
    Dim sh As Worksheets

    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name And wb.Name Like "小スケール*" Then
            Set targetWb = wb
            Exit For
        End If
    Next

    If targetWb Is Nothing Then
        MsgBox "目的のブックは開かれていません"
    Else
        'ここで目的のブックを処理
        If MsgBox(targetWb.Name & " で完了分を初期化します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbQuestion) = vbOK Then
            For Each sh In targetWb.Worksheets
                If sh.Index >= 4 Then
                    If sh.Range("K3") > 0 Then
                        targetWb.Worksheets(153).UsedRange.Copy sh.Range("A1")
                        On Error Resume Next
                        sh.Cells.SpecialCells(xlCellTypeComments).ClearComments
                        On Error GoTo 0
                    End If
                End If
            Next sh
            MsgBox "完了分の初期化が完了しました"
        Else
            MsgBox "キャンセルされました", vbExclamation
        End If
    End If

 End Sub

（β） 2015/11/25(水) 16:17

β様

そうなんですね～。まだまだ勉強不足です。

このファイルは客先指定なので、現在は構成を変更する提案をする予定はありません。
とりあえず現状で作業しやすくなれば、と思い今回のコード組みました。
シート数はこれ以上増える予定はなく、153番シートは使用される可能性が限りなく０に近いため指定しています。
使用もされないので、作業対象になることもない予定です…（過去を見てもないので）
もっと使いやすいファイルに出来るんでしょうけど…。

test1を使用させて頂きます！
こんなにスマートになるんですね…！

ありがとうございました！
（メロウ） 2015/11/26(木) 12:04

コメント返信：

[ 一覧(最新更新順) ]

[[20151125132912]] 『複数のブックを開いた状態で指定した文字を含むブ』（メロウ） ページの最後に飛ぶ

[[20151125132912]]　『複数のブックを開いた状態で指定した文字を含むブ』（メロウ）　ページの最後に飛ぶ