[[20180602171644]] 『転記および集計』(コルト) ページの最後に飛ぶ

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

 

『転記および集計』(コルト)

先日質問させて頂いた内容の続きになります。
あれから色々と試した結果かなり望んだ形になってきたので再度ご質問させていただきます。
複数のブック(年間個別受注数を出したので12個)を集計用のブックに転記して集計を行って一覧を表示しようと思っています。
現在できたコードは以下の通りです。


Option Explicit

Sub Macro1()
'
' Macro1 Macro
'

'

    Range("A2").Select
    Workbooks.Open Filename:="C:\Users\***\Desktop\test\2018年1月.xlsx"
    Range("A2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Users\***\Desktop\test\2018年2月.xlsx"
    Range("A2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Users\***\Desktop\test\2018年3月.xlsx"
    Range("A2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.Close
    Workbooks.Open Filename:="C:\Users\***\Desktop\test\2018年4月.xlsx"
    Range("A2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveWindow.Close
    ActiveSheet.Paste
    ActiveSheet.Paste
    ActiveSheet.Paste
    ActiveSheet.Paste
    Application.CommandBars("Office Clipboard").Visible = False
End Sub
Sub 集計()
Selection.Subtotal GroupBy:=3, Function:=xlCount, TotalList:=Array(5) _
        , Replace:=True, PageBreaks:=True, SummaryBelowData:=True
End Sub

これをtestフォルダに入っているxlsx形式のファイル全てに適用し、コードの簡略化および高速化が行えないでしょうか?
よろしくお願いします。

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


前質問のリンクがなくて、探してまで回答するのがめんどくさかったので、このトピックだけを見てですが

>コードの簡略化および高速化が行えないでしょうか?
高速化はともかく、簡略化はどこまで自分でできるのか回答者にはわかりません。

とりあえず、

 〇〇.Select
 Selection.××

となっているところは、多くの場合

 〇〇.××

と表現したほうが簡略化になるでしょうし、

    Workbooks.Open 〜〜〜
    (中略)
    ActiveWindow.Close

この部分も、ActiveWindowじゃなくて、変数に格納するか、Withステートメントを使って

        With Workbooks.Open(Filename:="C:\Users\***\Desktop\test\2018年1月.xlsx")
            (中略)
            .Close
        End With

としたらどうでしょうか。

ちなみに、COPYメソッドの引数に貼付を与えてるわけでもないようなので、
 1.ブックを開く
 2.セル範囲をコピーする
 3.どこにはりつけるわけでもなく
 4.ブックを閉じる
 5.よくわからないけどPasteメソッドを連続して複数実行する
ってなってるので、ちゃんと動いてるのかなぁって気になります。

私が知らないだけで↑でもできるのかもしれないですが、
COPYメソッドのあと、Pasteメソッドを実行してから、元データが入ってるブックを閉じる
って動きにしたほうが、オーソドックスというか、コードが読みやすい様におもいます。
(もっと言えば、COPYメソッドの引数に貼付先を与えて、一度に記述してしまえば、Pasteメソッドをわざわざ実行しなくてもいいんじゃないかと思ったり・・・・)

(もこな2) 2018/06/02(土) 18:24


>先日質問させて頂いた内容の続きになります。

ならば、新しく質問せずに、続ければよいのに…

[[20180526095304]] 『フォルダ内集計』(コルト) 
[[20180526161213]] 『転記とループ処理』(コルト)
[[20180528114255]] 『繰り返し処理』(コルト)

(マナ) 2018/06/02(土) 19:00


シート間の転記の場合は、転記元、転記先ともに、
どのシートなのかを明示するようにしてください。

転記元ブック.シート.セル範囲.Copy
転記先ブック.シート.セル.Pastespecial xlPasteValues

(マナ) 2018/06/02(土) 19:29


どの質問も聞きっぱなしで解決したのかそうでないのか、質問者さんからの反応ないけど、もしかして質問したいんじゃなくて、単にコードを提供してほしいってことなのかなぁ・・・

とりあえず、↓みたいに整理してみたらどうです?(テストしてないから動くかはしらないけど)

    Sub Macro1_改()
        Dim dstRNG As Range
        Dim MySTR(3) As String
        Dim tmp As Variant
        Dim i As Long

        MySTR(0) = "C:\Users\***\Desktop\test\2018年1月.xlsx"
        MySTR(1) = "C:\Users\***\Desktop\test\2018年2月.xlsx"
        MySTR(2) = "C:\Users\***\Desktop\test\2018年3月.xlsx"
        MySTR(3) = "C:\Users\***\Desktop\test\2018年4月.xlsx"

        With ThisWorkbook.ActiveSheet
            Set dstRNG = .Range("A2")

            For i = 0 To 3
                With Workbooks.Open(Filename:=MySTR(i))
                    With .Worksheets(1).Range("A2")
                        .Range(.Cells, .Cells(.End(xlDown).Row, "M")).Copy dstRNG
                    End With
                    .Close
                End With

                Set dstRNG = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)

            Next i

        End With

        Application.CommandBars("Office Clipboard").Visible = False

    End Sub

(もこな2) 2018/06/02(土) 21:51


マナさん、もこな2さんありがとうございます。
とりあえず上記の情報を頼りにやってみます。
(コルト) 2018/06/04(月) 10:06

コメント返信:

[ 一覧(最新更新順) ]


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