重要なお知らせ

「教えて! goo」は2025年9月17日(水)をもちまして、サービスを終了いたします。詳細はこちら>

【GOLF me!】初月無料お試し

マクロ本当に初心者です。
下記の動きを合わせて実現したいのですが、頼れるのが質問サイトしかない状況で、、
滅茶苦茶困ってます!ご助力いただけないでしょうか。。

(1)ファイル「*あいう*」(※)の「シート#1」のF5→AE24までの値をコピー
→上記の値をすべて加算し、「貼り付け先ファイル」のF5→AE24に貼り付け
※「某フォルダ」に存在する、ファイル名に「あいう」を含むすべてのファイル(ファイル数は可変)が対象
(2)上記を同様の動きを、範囲のすべてのセルでなく、
(F25:F42)、(H25:H42)、、~(AD25:AD42)と1列ごとに対して行う

方々で知識のある方からご助力いただき、
下記の「それっぽい」記述までは辿り着いたのですが、上手く動かず。。
また、(1)と(2)は1つにできるのでは?とも推測してますが、どのように書けば間違いないのかわからない状況です…!

知識のある方から、間違いや改善点などご教示いただけたらとてもうれしいです。

Sub (1)()

Dim folder As String
Dim dws As Worksheet
Dim sfile1 As String
Dim swb1 As Workbook
Dim adr As String

folder = "C:\Users\某フォルダ\"
Set dws = ThisWorkbook.Worksheets("貼り付け先シート")
sfile1 = Dir(folder & "*あいう*.xlsm")
If sfile1 = "" Then Exit Sub

Set swb1 = Workbooks.Open(folder & sfile1)

adr = Range(Cells(5, 6), Cells(24, 31)).Address(0, 0, 1)

swb1.Sheets("シート#1").Range(adr).Copy
dws.Range(adr).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd

swb1.Close False
End Sub


Sub (2)()

Dim folder As String
Dim dws As Worksheet
Dim sfile1 As String
Dim swb1 As Workbook
Dim adr As String
Dim c As Integer

folder = "C:\Users\某フォルダ\"
Set dws = ThisWorkbook.Worksheets("貼り付け先シート")

sfile1 = Dir(folder & "*あいう*.xlsm")
If sfile1 = "" Then Exit Sub

Set swb1 = Workbooks.Open(folder & sfile1)

For c = 6 To 30 Step 2
adr = Range(Cells(25, c), Cells(42, c)).Address(0, 0, 1)

swb1.Sheets("シート#1").Range(adr).Copy
dws.Range(adr).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
Next

swb1.Close False
End Sub

A 回答 (9件)

No.6 文字化けしてました。

すみません!面倒なので全部載せちゃいます。

Sub マクロ()

Const ファイル名 As String = "*あいう*.xlsm"
Dim ファイルシステム As Object
Set ファイルシステム = CreateObject("Scripting.FileSystemObject")
Dim ファイル As Object
Dim 纒シート As Variant
Dim データシート As Variant
Dim 縦 As Long
Dim 横 As Long

 Sheets("貼り付け先シート").Select
 纒シート = Range("F25:AD42")
 For 縦 = 1 To 18
  For 横 = 1 To 25 Step 2
   纒シート(縦, 横) = 0
  Next
 Next
 For Each ファイル In ファイルシステム.GetFolder(ThisWorkbook.Path & "\").Files
  If ファイル.Name Like ファイル名 Then
   Workbooks.Open Filename:=ThisWorkbook.Path & "\" & ファイル.Name
   Sheets("シート#1").Select
   データシート = Range("F25:AD42")
   ActiveWindow.Close
   For 縦 = 1 To 18
    For 横 = 1 To 25 Step 2
     纒シート(縦, 横) = 纒シート(縦, 横) + データシート(縦, 横)
    Next
   Next
  End If
 Next
 Range("F25:AD42") = 纒シート

End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。。。

上記のコードの解釈としては、以下で合っていますか…?

貼り付け先シートのセルを指定、F25:AD42の範囲内の値を0にする
→「あいう」を含むすべてのファイルを見つけてきて、開く
→開いたファイルのF25:AD42の範囲内から、F25:F42、H25:H42、、のセルを選択
→貼り付け先シートのF25:AD42(※0になっている)に「あいう」を含むすべてのファイルの、選択されたセルの数値を加算して収める

お礼日時:2019/11/20 17:39

No.8 の一部訂正



「④「纒シート」に「データシート」の F25:F42、…、F25:AD42 に該当する部分を加算していく」はもちろん「④「纒シート」に「データシート」の F25:F42、…、AD25:AD42 に該当する部分を加算していく」です。本当に申し訳ございません。
    • good
    • 1

No.7 の説明



① 貼り付け先シートの F25:AD42 を「纒シート」と言う配列変数に代入し加算される所を0で初期化
 (1つ目のファイルだけ別処理するのが面倒だった)
② 同じフォルダのファイル名を調べ「あいう」を含んでいたら開いて「シート#1」シートを選択する
③ F25:AD42 を「データシート」と言う配列変数に代入しすぐ閉じる
④「纒シート」に「データシート」の F25:F42、…、F25:AD42 に該当する部分を加算していく
⑤ ②~④ をファイルが無くなるまで繰り返す
⑥「纒シート」を F25:AD42 に代入して終了
    • good
    • 1

No.5 修正 気づいているとは思いますがシート名に対する回答が無かったので「Sheets("?V?[?g#1").Select」を入れていませんでした。

場所判りますよね?
    • good
    • 0

貼り付け先ファイルと同じフォルダに全てのファイルが有るとしてですが、以下の様な物はいかがでしょうか?


※「*あいう*.xlsm」は全て閉じておいてください。勝手に開いて閉じます。

Sub マクロ()

Const ファイル名 As String = "*あいう*.xlsm"
Dim ファイルシステム As Object
Set ファイルシステム = CreateObject("Scripting.FileSystemObject")
Dim ファイル As Object
Dim 纒シート As Variant
Dim データシート As Variant
Dim 縦 As Long
Dim 横 As Long

 Sheets("貼り付け先シート").Select
 纒シート = Range("F25:AD42")
 For 縦 = 1 To 18
  For 横 = 1 To 25 Step 2
   纒シート(縦, 横) = 0
  Next
 Next
 For Each ファイル In ファイルシステム.GetFolder(ThisWorkbook.Path & "\").Files
  If ファイル.Name Like ファイル名 Then
   Workbooks.Open Filename:=ThisWorkbook.Path & "\" & ファイル.Name
   データシート = Range("F25:AD42")
   ActiveWindow.Close
   For 縦 = 1 To 18
    For 横 = 1 To 25 Step 2
     纒シート(縦, 横) = 纒シート(縦, 横) + データシート(縦, 横)
    Next
   Next
  End If
 Next
 Range("F25:AD42") = 纒シート

End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます、、!
こちらを参考にし期待する動きを実現することができました!

お礼日時:2019/11/21 11:21

こんにちは



Sub (1)()とSub (2)()の関係がよくわからないのと、文章には「すべてのファイル(ファイル数は可変)」とあるけれど、それに対応するコードが…??

よくわからないので、かなり適当な推測混じりですが、こんなことをなさりたいのでしょうかね?(はずれてたらスルーしてください)

Sub Sample()
Dim swb As Workbook, tmpsh As Worksheet, dsh As Worksheet
Dim sfile As String, col As Long

Const folder = "C:\Users\某フォルダ\"
Const sname = "シート#1"
Const area = "F25:AD42"

Application.ScreenUpdating = False
Set dsh = ThisWorkbook.Worksheets("貼り付け先シート")
Set tmpsh = ThisWorkbook.Worksheets.Add

sfile = Dir(folder & "*あいう*.xlsm")
While sfile <> ""
 Set swb = Workbooks.Open(folder & sfile)
 swb.Worksheets(sname).Range(area).Copy
 tmpsh.Range(area).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
 swb.Close savechanges:=False
 sfile = Dir()
Wend

For col = 1 To Range(area).Columns.Count Step 2
 dsh.Range(area).Columns(col).Value = tmpsh.Range(area).Columns(col).Value
Next col

Application.DisplayAlerts = False
tmpsh.Delete
Application.DisplayAlerts = True
dsh.Activate
Application.ScreenUpdating = True

End Sub
    • good
    • 1

スマホなので何ですが、AE25:AE42ってどうなってるのですか?



影響しないなら、F5:AE42を加算コピペ出来そうに感じるのですが。。。
    • good
    • 0
この回答へのお礼

G列、I列、、AE列は、加算コピペした数値をもとに数式を組んで%表示にしたいのです。(例えばG25=F25/F5*100)
数式が入ると難しくなるかな、、、という発想で、数式を入れてマクロの範囲から除外する方法で検討していました。
が、マクロで上記式も組んでしまった方が良かったでしょうか。。

結論としては、数式込みでも比較的すっきりマクロを組めるなら、②はF25:AE42の範囲で書くのがベストということになるのではと思います…!

お礼日時:2019/11/20 16:37

念のための確認ですが、今回はシート名は「シート#1」固定で良いですか?

    • good
    • 0
この回答へのお礼

お世話になります。。
今回のシート名は、「シート#1」固定です。

お礼日時:2019/11/20 16:29

全てとは順番は問わないのですか?


あと『あいう』は固定若しくは変動(任意に入力したい)のどちらですか?

でも類似複数ファイル名に対して行ないたかったのなら、
先の質問でそのように記載して欲しかったかな。
    • good
    • 0
この回答へのお礼

度々ありがとうございます、そしてすみません。。
コーディングに限りませんが、全体像を捉えてからから挑むのがスマートですね。。勉強になります。

>全てとは順番は問わないのですか?
はい。問いません。

>あと『あいう』は固定若しくは変動(任意に入力したい)のどちらですか?
『あいう』の文字列は固定です。前後(ファイルのバージョン名など)の値は変わります。

お礼日時:2019/11/20 15:45

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

今、見られている記事はコレ!