Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Microsoft 365)
複数ファイル 特定シート 1つのシートに追記していく
投稿日時: 24/01/29 20:24:22
投稿者: パウパト

大変困っており、お力お貸しいただけると幸いです。
何卒よろしくお願いいたします。
 
同じフォルダ内に複数のExcelファイルがあります。
全ファイルを1つずつ開いて、シート名「まとめ」に記載のあるA2:O1001の範囲をコピーし、統合.xlsmのシート名「集約」のA2:O1001に値貼り付けをします。次に開いたファイルは「集約」シートの次の行から値貼り付けをしていくという流れをイメージしております。
 
この作業を統合.xlsmのシート名「マクロ」実行に「統合」ボタンを設けたので、それを押せば実行できるVBAは作成可能でしょうか?
 
全てのファイルの「まとめ」シートを統合.xlsmのシート名「集約」に追記していくイメージとなります。
 
ご協力よろしくお願いいたします。

回答
投稿日時: 24/01/29 21:07:18
投稿者: simple

ひとつのブックについて、できますか?
コピーして値貼り付けという作業をマクロ記録すると骨格のコードが得られます。
それを元にすればできそうです。
 
一つのフォルダの配下の複数ファイルに同じことを繰り返す部分については、
こちらのサイトの即効テクニックという特集ページに参考例があります。
「複数ブックのシートを1つのブックにコピーする」
https://www.moug.net/tech/exvba/0060003.html
などを参照してください。
 
以上のことを参考にしてトライしてみて下さい。
そして詰まったところがあれば、続けて具体的に質問して下さい。
 
なお、こちらのサイトでは作成依頼的なことは管理人さんからダメ出しがされています。
https://www.moug.net/faq/kiyaku.html#link1
の禁止事項として挙げられているようですので、上記の方針で頑張ってみてください。

回答
投稿日時: 24/01/30 11:25:48
投稿者: simple

シートの最後尾に続けてコピーしていくところは、下記が参考になるでしょう。
これもこちらのサイトの即効テクニックです。
「複数のシートのデータを1つのシートにコピーする」
https://www.moug.net/tech/exvba/0040062.html

投稿日時: 24/01/30 23:39:38
投稿者: パウパト

simple様、大変ご多忙の中、恐れ入ります。本当にありがとうございます。
また、反応が遅くなり大変申し訳ございません。VBA全くの素人で記事を読んだのですが、全然わかりませんでした。申し訳ございません。
マクロの記録で下記の構文ができあがったのですが、11行目で引っかかってしまいます。
アドバイスいただけないでしょうか。
 
1Sub Macro1()
2 Range(Selection, Selection.End(xlDown)).Select
3 Range(Selection, Selection.End(xlToRight)).Select
4 Selection.Copy
5 Windows("統合.xlsm").Activate
6 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
7 :=False, Transpose:=False
8 Range("A2").Select
9 Selection.End(xlDown).Select
10 Range("A1002").Select
11 Windows("/").Activate
12 ActiveWindow.Close
13 Sheets("まとめ").Select
14 Range("A2").Select
15 Range(Selection, Selection.End(xlDown)).Select
16 Range(Selection, Selection.End(xlToRight)).Select
17 Selection.Copy
18 Windows("統合.xlsm").Activate
19 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
20 :=False, Transpose:=False
21End Sub

投稿日時: 24/01/30 23:40:38
投稿者: パウパト

パウパト さんの引用:
simple様、大変ご多忙の中、恐れ入ります。本当にありがとうございます。
また、反応が遅くなり大変申し訳ございません。VBA全くの素人で記事を読んだのですが、全然わかりませんでした。申し訳ございません。
マクロの記録で下記の構文ができあがったのですが、11行目で引っかかってしまいます。
アドバイスいただけないでしょうか。そもそもこの構文自体が違うように感じております。
他のところでもひっかかりそうです・・・
 
1Sub Macro1()
2 Range(Selection, Selection.End(xlDown)).Select
3 Range(Selection, Selection.End(xlToRight)).Select
4 Selection.Copy
5 Windows("統合.xlsm").Activate
6 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
7 :=False, Transpose:=False
8 Range("A2").Select
9 Selection.End(xlDown).Select
10 Range("A1002").Select
11 Windows("/").Activate
12 ActiveWindow.Close
13 Sheets("まとめ").Select
14 Range("A2").Select
15 Range(Selection, Selection.End(xlDown)).Select
16 Range(Selection, Selection.End(xlToRight)).Select
17 Selection.Copy
18 Windows("統合.xlsm").Activate
19 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
20 :=False, Transpose:=False
21End Sub

回答
投稿日時: 24/01/31 08:36:00
投稿者: simple

(1)
マクロ記録を取って調べるのは、コピーして値貼り付けする部分かと思います。

Selection.Copy
’(中途省略)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
のあたりが参考になります。
  Operation:=xlNone以下のところは、既定値ですから記載が省略できます。
 (書いても問題は生じません)
 
すべてをマクロ記録して、それを逐一修正していくのはかえって負荷が高まってしまい
効率が悪いと思われます。
特定の部分だけに注目して、構文をヘルプで調べるための情報として活用する、
と言った使い方をすることが多いと思います。
 
(2)
既に開いてあるブックであれば、下記のようなコードで、コピーと値貼り付けができます。
これでファイルがひとつのケースの場合は終了です。
Sub test()
    Dim ws    As Worksheet
    Dim wsDest As Worksheet

    Set wsDest = ThisWorkbook.Worksheets("集約")
                'ThisWorkbook はコードを作成しているworkbook(統合.xlsm)を指します
    Set ws = Activeworkbook.Worksheets("まとめ")
    ws.Range("A2:O1001").Copy
    wsDest.Range("A2").PasteSpecial Paste:=xlPasteValues
End Sub

(3)
これを、特定のフォルダの配下にある全Excelブックに対して繰り返し処理をするには、
例えば、以下のようなコードにすればよいでしょう。
Sub main()
    Const SOURCE_DIR As String = "C:\Data\Source\" '環境に合わせて変更してください
    Dim filename As String
    Dim wb       As Workbook
    Dim ws       As Worksheet
    Dim wsDest   As Worksheet

    Application.ScreenUpdating = False
    
    Set wsDest = ThisWorkbook.Worksheets("集約")

    filename = Dir(SOURCE_DIR & "*.xls*")
    If filename = "" Then Exit Sub
    Do
        Debug.Print filename 
        Set wb = Workbooks.Open(filename:=SOURCE_DIR & filename)
        wb.Worksheets("まとめ").Range("A2:O1001").Copy
        wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _
               Paste:=xlPasteValues
        wb.Close False
        filename = Dir()
    Loop While filename <> ""

    ThisWorkbook.Save '確認してから手動で保存したほうがよいかも知れません
    Application.ScreenUpdating = True
End Sub

最初はステップ実行して一つのブックで試してみて下さい。
動作を目視確認するために、下記の画面更新の抑止はいったんコメントにしておいて、
完成してから元に戻すとよいでしょう。
    ' Application.ScreenUpdating = False
# なお、即効テクニックにあるコードの最後の行は、もちろん
# Application.ScreenUpdating = True
# の間違いです。(編集漏れですね)
 
なお、どのブックをどの順番で読み込んだかがわからないといけないので、
        Debug.Print filename 
とイミディエイトウインドウに出力しています。
(集約シートの貼り付け先範囲の右の列にブック名を書きつける、
  と言った工夫をされてもよいかもしれません。)

投稿日時: 24/01/31 23:38:43
投稿者: パウパト

simple様、大変恐れいります。親切にご対応、並びにご回答いただき誠にありがとうございます。正直めちゃくちゃ感動しております。
「マクロ実行」というシートのボタン「Macro1」を押下しても処理やデバックなども起きずに無反応となります。どんな原因が考えられますでしょうか。何度も申し訳ございません。下記のフォルダは環境に合わせて変更させていただきました。
また、コピー元のファイルと統合ファイルは同じフォルダパスに格納しており、今後も同じフォルダに格納したいので、絶対パス?にするためにはどうしたら良いでしょうか。無知なので、アドバイス頂戴できると幸いです。
 
Sub Macro1()
  
 
   Const SOURCE_DIR As String = "C:\Data\Source\" '環境に合わせて変更してください
    Dim filename As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsDest As Worksheet
 
    Application.ScreenUpdating = False
     
    Set wsDest = ThisWorkbook.Worksheets("集約")
 
    filename = Dir(SOURCE_DIR & "*.xls*")
    If filename = "" Then Exit Sub
    Do
        Debug.Print filename
        Set wb = Workbooks.Open(filename:=SOURCE_DIR & filename)
        wb.Worksheets("まとめ").Range("A2:O1001").Copy
        wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _
               Paste:=xlPasteValues
        wb.Close False
        filename = Dir()
    Loop While filename <> ""
 
    ThisWorkbook.Save '確認してから手動で保存したほうがよいかも知れません
    Application.ScreenUpdating = False
End Sub

投稿日時: 24/02/01 00:40:15
投稿者: パウパト

あと、元のファイルで相談なのですが・・・
【誕生日管理表】.xlsm
「貼付」シート
1 O1=TODAY() '今日日付
2 P1=MID(E1,7,10)*1 'E列の7桁から10文字抽出。本来、数字があればその1文字から次の空白まで抽出したい。
3 Q1=E2 'E2の日付とイコール
4 R1=DATEDIF(Q1,$O$1,"Y")&"年"&DATEDIF(Q1,$O$1,"YM")&"ヶ月" '3行目の日付から何年何ケ月経過しているか表示
5 S1=VLOOKUP(P1,$L$1:$N$1000,3,FALSE) 'P1とヒットした番号から右3列目を抽出。
6 T1=F2 'F2の日付とイコール
7 U1=J1 '日付と今日日付
8 V1=G2 'G2とイコール
9 W1=J2 'J2とイコール
10 X1=H2 'H2とイコール
11 Y1=I2 'Y1の日付とイコール
12 Z1=DATEDIF(Y1,$O$1,"Y") '現在の年数
13 AA1=MID(E1,20,10)  'E列の20桁から10文字抽出。本来、20文字目から次の空白まで抽出したい。
14 AB1=$A$1 '$A$1と絶対にイコール
15 AC1=$B$1 '$B$1と絶対にイコール
16 AD1=$C$1 '$C$1と絶対にイコール
 
この上記の関数をE列にデータがある限り実行するというマクロは存在しますでしょうか。
 
「まとめ」シート
1 A1=INDIRECT("貼付!P"&ROW(貼付!P1)*2-1)
2 B1=INDIRECT("貼付!Q"&ROW(貼付!Q1)*2-1)
3 C1=INDIRECT("貼付!R"&ROW(貼付!R1)*2-1)
4 D1=INDIRECT("貼付!S"&ROW(貼付!S1)*2-1)
5 E1=INDIRECT("貼付!T"&ROW(貼付!T1)*2-1)
6 F1=INDIRECT("貼付!U"&ROW(貼付!U1)*2-1)
7 G1=INDIRECT("貼付!V"&ROW(貼付!V1)*2-1)
8 H1=INDIRECT("貼付!V"&ROW(貼付!V1)*2-1)
9 I1=INDIRECT("貼付!X"&ROW(貼付!X1)*2-1)
10 J1=INDIRECT("貼付!Y"&ROW(貼付!Y1)*2-1)
11 K1=INDIRECT("貼付!Z"&ROW(貼付!Z1)*2-1)
12 L1=INDIRECT("貼付!AA"&ROW(貼付!AA1)*2-1)
13 M1=貼付!$A$1
14 N1=貼付!$B$1
15 O1=貼付!$C$1
16 P1
 
この上記の関数を「貼付」シートP列にデータがある限り実行するというマクロは存在しますでしょうか。
 
「重複」シート
1 K列に”重複”フラグを設けたので、空白表示。
 
これが出来れば、先んじてご回答いただいた結合ファイルの
Range("A2:O1001").Copy がデータがある場合、A列からO列をコピーして値貼り付けができるかなと考えております。分かりづらい場合は大変申し訳ございません。
 
関数はかじったことがあるので、微妙に分かる部分もあるのですが、VBAは何からやればいいのかもよく理解できておりません。
大変申し訳ございませんが、ご協力の程よろしくお願いいたします。
処理件数が非常に多く、効率が悪いので、お知恵を拝借できると幸いです。

回答
投稿日時: 24/02/01 10:22:17
投稿者: WinArrow

> wb.Worksheets("まとめ").Range("A2:O1001").Copy
についての質問
 
このセル範囲指定は、データ量が増えて、セル範囲を超えた場合、
超えた分は複写されません。
 
常に(どのシートも)セル範囲は固定で問題ないとお考えなんですか?
 
 

回答
投稿日時: 24/02/01 10:28:06
投稿者: simple

ステップ実行をご存じですか?
コードを一行ずつ実行していって、処理がうまくいっているかを確認することができます。
https://hp.vector.co.jp/authors/VA016119/step/step01.html
これを使って、たとえば、ファイル名が取得出来ているかどうかなども含めて、
どこで正しい道から外れてしまっているかを調べて下さい。
 
Const SOURCE_DIR As String = "C:\Data\Source\" '環境に合わせて変更してください
ここはどう変更しましたか。
ありがちな間違いは、最後の\が抜けてしまうというものです。
注意喚起が乏しかったかもしれませんが、確認してください。

回答
投稿日時: 24/02/01 10:35:01
投稿者: simple

後半の質問は前半となにか関係していますか?
そうでなければ質問を別のスレッドで挙げ直したほうがよいとおもいます。

回答
投稿日時: 24/02/01 13:14:10
投稿者: simple

質問の一部を読み飛ばしていました。回答します。

引用:
また、コピー元のファイルと統合ファイルは同じフォルダパスに格納しており、今後も同じフォルダに格納したいので、絶対パス?にするためにはどうしたら良いでしょうか。

同じフォルダに入れるなら、統合ファイルは読み込んで処理しないようにする必要があります。
    Do
        If fileName <> "統合.xlsm" Then
            Debug.Print fileName
            Set wb = Workbooks.Open(fileName:=SOURCE_DIR & fileName)
            wb.Worksheets("まとめ").Range("A2:O1001").Copy
            wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _
                    Paste:=xlPasteValues
            wb.Close False
        End If
        fileName = Dir()
    Loop While fileName <> ""
などとすると良いと思います。(この修正は動作未確認です)
 
"絶対パスにする"というのは趣旨が分かりません。
今でもフォルダを指定して、
Workbooks.Open(fileName:=SOURCE_DIR & fileName)
と絶対パスで読み込んでいますよ。懸念点をもうすこし詳しく説明してください。
 
ちなみに、私は特に断らない限りは、テスト実行したうえで投稿しています。
シート内容がコピーされることを確認しています。なにも動作しないようなものは提示しません。
もっとも、パス名とかシート名は別名でテストはしていますが。

回答
投稿日時: 24/02/01 16:36:43
投稿者: WinArrow

INDIREC案数について
 
この関数は揮発性関数といって、多用すると、再計算のため、処理時間が掛かり、
効率が悪いと思います。

投稿日時: 24/02/01 20:46:14
投稿者: パウパト

WinArrow様
気にかけていただき、誠にありがとうございます。感謝申し上げます。
 
>この関数は揮発性関数といって、多用すると、再計算のため、処理時間が掛かり、
>効率が悪いと思います。
 
仰る通り、非常に時間がかかっており、困っております。
 
>常に(どのシートも)セル範囲は固定で問題ないとお考えなんですか?
>INDIREC案数について
 
今は元ファイルに関数が入っている状況なので、固定でご質問させていただいた次第になります。
本来、実施したい内容は元ファイルのA列からO列の2行目以降、データがあれば値貼り付けをしたいというのが本音となります。投稿の順番が逆で分かりづらくて大変申し訳ございません。

投稿日時: 24/02/01 20:54:41
投稿者: パウパト

simple様
ご指導いただき本当にありがとうございます。ステップ実行は存じ上げていなかったです。
また、ご指摘いただいた通り、フォルダの最後の\が抜けていたことで実行できていませんでした。
 
下記の件、大変失礼いたしました。ご指摘いただきありがとうございます。感謝申し上げます。別のスレッドで挙げ直させていただきます。
>後半の質問は前半となにか関係していますか?
>そうでなければ質問を別のスレッドで挙げ直したほうがよいとおもいます。
 
下記のコードの部分ですが、A2:O2のデータがある部分までコピーするということは可能でしょうか?
> wb.Worksheets("まとめ").Range("A2:O1001").Copy
 
私がやりたかったことは、ご指導のお陰で実行することができました!本当にありがとうございます!
非常に感動しております。私の質問が分かりづらくて、ご迷惑をお掛けしております。
大変申し訳ございません。

回答
投稿日時: 24/02/01 21:13:11
投稿者: simple

> あと、元のファイルで相談なのですが・・・
> 【誕生日管理表】.xlsm

元の「統合.xlsm」とは別のブックなんでしょ?何か関係があるんですか?
テーマ的には全く別のもののように思います。
質問者にとっても、閲覧者にとっても、別のテーマなら分けたほうがよい、
と思うんですがね。
 
> これが出来れば、先んじてご回答いただいた結合ファイルの
> Range("A2:O1001").Copy がデータがある場合、
> A列からO列をコピーして値貼り付けができるかなと考えております。

全く意味がとれません。
 
さて、賛同されないようなので、あえてコメントしておきます。
> この上記の関数をE列にデータがある限り実行するというマクロは存在しますでしょうか。
存在なんかするわけないですよ。
製品でもなんでもないので、こちらは在庫を沢山持っている訳ではありません。
コードなんていうものは、それぞれが工夫して作成するものですから。
 
■後半部分の「貼付」シート
説明が不十分でよくわかりませんが、
要するに2行単位で計算がされているように見受けます。
ですから、基本的には、最初の2行を、コピーペイストすることで対応できませんか?
今は、手作業でどんなことをされているんですか?
ひとつのシートであれば、手作業で十分に対応できる話ではないですか?
 
E列がどんなデータなのか(一行おきにデータがあるのか、
連続してなにかが入っているのか)不明なので、以下は推測が入ります。
 
・lastRow = Cells(Rows.Count, "E").End(xlUp).Row で"最終行"を求めます。
・O1:AD2の2行にわたるセル範囲を、
・O3から AD列のlastRow行(または、lastRow+1 行)までの
  偶数行で構成されるセル範囲に貼り付ける
ことで、それらの式が機能するのではないですか?
 
コピーペイストについては、基本的なコードですから、どんなテキストにも載っています。
 
■「まとめ」シート
これも単純にコピーペイストの話ではないですか?
手作業でもいいですし、それをマクロ記録して幾分修正すればよいでしょう。

回答
投稿日時: 24/02/02 10:47:48
投稿者: WinArrow

引用:

        Set wb = Workbooks.Open(filename:=SOURCE_DIR & filename)
        wb.Worksheets("まとめ").Range("A2:O1001").Copy


> wb.Worksheets("まとめ").Range("A2:O1001").Copy
のデータがあるだけに対応したコードを紹介します。
 
Dim SourceRange As Range

    With wb.Worksheets("まとめ")
    'A列〜O列の間に空白列がない場合
        With .Range("A1").CurrentRegion
            Set SourceRange = Intersect(.Cells, .Offset(1))
        End With
    'A列〜O列の間に空白列がある場合
        With .Range("A1").Resize(WorksheetFunction.CountA(.Columns("A")))
            With .Resize(, .Parent.Columns("O").Column)
                Set SourceRange = Intersect(.Cells, .Offset(1))
            End With
        End With
    End With
    SourceRange.Copy

回答
投稿日時: 24/02/02 11:34:55
投稿者: simple

開いたままでしたので、投稿があるのを見損じてしまいました。
議論の場はどちらでも結構です。質問者さんが決めてください。
 
単純なコピーという話ではない、ということなら、
シートのレイアウト、項目の説明、をきちんとしてもらう必要があります。
式だけ示した質問などというものはありえません。
立場を逆転して考えて見て下さい。
意図もわからず、画面もなにも見えていないんですよ。

投稿日時: 24/02/03 01:15:50
投稿者: パウパト

simple様、WinArrow様
反応が遅くなり大変申し訳ございません。アドバイスをいただき本当にありがとうございます。
お蔭様でやりたい処理を完了することができました。感謝申し上げます。
そして、質問が分かりづらすぎて、ご迷惑をお掛けして大変申し訳ございません。
 
度重なる質問で大変申し訳ございませんが、最後の処理として、
@マクロ実行ボタンだけがある「マクロ実行」シートの非表示
A「集約」シートにPWをかけてシートの保護
をしたいのですが、アドバイスいただけないでしょうか。
 
>>simple様
仰る通り、分かりにくく大変申し訳ございませんでした。
現在、まとめておりますので、別スレッドにてご質問させていただきます。
アドバイスいただき誠にありがとうございます。

回答
投稿日時: 24/02/03 08:35:18
投稿者: WinArrow

引用:

@マクロ実行ボタンだけがある「マクロ実行」シートの非表示
A「集約」シートにPWをかけてシートの保護

両方ともマクロン記録でコードが入手可能と思います。
 
ところで、@で「マクロ実行用」ボタンが見えないブックを開いたときの
マクロはどのように起動するのか、対策ができているんでしょうか?
 
もし、そのような対策があるちすれば、
「マクロ実行用」ボタンは不要と思いますが・・・・

回答
投稿日時: 24/02/03 09:36:54
投稿者: WinArrow

パウパト さんの引用:

お蔭様でやりたい処理を完了することができました。

完了というのは、できあったコードが動けばよいということではありませんよ。
 
今後発生する状況変化や条件変化に対応して、
自分でメンテナンスができる
というレベルになっていることです。
 
コードの意味が理解できているならば、質問の仕方も変わってくるはずです。
 

投稿日時: 24/02/08 00:35:05
投稿者: パウパト

Winarrow様
娘が熱を出してしまい反応が遅れました。申し訳ありません。
仰る通りだなと思い、反省しております。何か不具合が出たらまたご相談させていただきたく、
その際はご協力いただけますと幸いです。
引き続き何卒よろしくお願いいたします。