[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数ブックから数値を転記するマクロを教えてください。』（追い込まれびと）
VBA初心者の私に至急どなたかマクロのコードを教えてください（涙）
やりたいことは以下のとおりです。
【勤務時間の集約】
1 県ごと（福岡、佐賀、大分…）のexcelブック（ブック名に県名）に役職ごと（部長、課長、係長1、係長2、係員1、係員2…）のシート（シート名に役職）が作成され、業務別の勤務時間（C5:C45の値）が入力されている。
2 上記1が30ブック存在あり、様式はすべて同じ（セル番も同じ）。一つのフォルダにまとめられている。
3 集約用のブックには、役職ごとにシートがあり、各シートは横軸に県名、縦軸に業務名の表が作成されている（最初の県はD5:D45部分にペーストすることになる。以降右に続く）。
4 ちなみに、役職は各県揃っておらず、係長が1人のところもあれば2人以上のところもある。
5 上記1のブックの役職ごとの数値を上記3の集約用ブックの役職ごとのシートに転記させたい。
以上です。
調べた限りでは、For文の中にFor each文を入れる？のかなと考えていますが、基礎知識が少なく手が止まっております。
どなたかの知恵を貸してください！！
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
■２
＞一つのフォルダにまとめられている。
＞ブック名に県名～役職ごとのシート（シート名に役職）が作成
そのフォルダに、対象ブック以外のファイルがあるかによって詳細はかわりますが、基本は
(1)フォルダ内の全ファイルを巡回して (2)順番にブックを開いて (3)開いたブックの全シートを巡回して (4)ブック間でコピペする (5)開いたブックを閉じる ※(2)～(5)を繰り返す
みたいになるとおもいます。
■３
＞集約用のブックには、役職ごとにシートがあり
＞各シートは横軸に県名、縦軸に業務名の表が作成されている
＞（最初の県はD5:D45部分にペーストすることになる。以降右に続く）。
シートはデータ側と集計側で同じ名前のものにすればよいですね。
一方で、貼付先セルは最初の県であるか否かに関わらず、開いたブック名（＝県名）をキーに列を特定することになるんじゃないですか？
行のほうは5行目で固定でよいのかもしれませんが・・・
■４
＞調べた限りでは、For文の中にFor each文を入れる？のかなと考えていますが、基礎知識が少なく手が止まっております。
ループ処理の部分がわからないのであれば、一旦そこは置いておいて、例えば、「福岡.xlsx」だけを処理するみたいに考えてみてはどうでしょうか？
それでもうまくいかないのであれば、具体的なコードと、どのように上手くいかないのか
・エラーが出る場合：エラーが発生する箇所とエラー内容（エラー番号、エラーメッセージ）
・エラーは出ないが予定と違う場合：××になる予定が△△になってしまう
等をお伝え頂くとアドバイスできることがあるかもしれません。
（もこな２） 2019/11/15(金) 04:05
おはようございます ＾＾気が付いた点だけですみません。 １．県別ＢＯＯＫの役職シート ２．集約シートの役職シート のフォーマット（表形式）を３，４行でもよいので（個人情報はダミーで） ご説明いただくと、さらに、具体的アドバイス、回答が有るかもしれません ← 多分 ＾＾； １．全員分のシートが双方にあるのでしょうか ２．４０行分の情報は何をいみするのでしょうか日付別勤務時間？ 、業務の種類別勤務時間？ m(_ _)m （隠居じーさん） 2019/11/15(金) 09:52
こういう流れかな
（べん） 2019/11/15(金) 10:13
勤務時間
総務事務 10.50
広報事務 15.25
2集約ブック（単位:時間）同じシートが役職ごとあります
福岡 佐賀 大分
総務事務
広報事務
3 報告用ブックには在籍者シートしかありません。
例）シート:部長、係長1
集約用ブックには全県に対応するシートがあります。
例）シート:部長、課長、係長1、係長2…
4 40行は事務種類が40種類あります。
報告用ブックは事務種類別の月計勤務時間が入力されたものです。
（追い込まれびと） 2019/11/15(金) 12:27
こんにちは ＾＾
４０種類はどのシートも同じ順に同じ列、行にある
県名はファイル名のドットの手前までと同じである（＠＠県.xl、＠＠都.xl*、＠＠府.xl*
前程で ＾＾；。。。べん さん のロジックを参考にさせて頂いて。
ザックリですので、参考程度にお止め下さい。テスト環境作れなか
ったので。。。 ← 言い訳 A^_^;
いろいろ不都合が有るかと思いますが一案で
Option Explicit
Sub OneInstance()
Dim Wb As Workbook
Dim i As Long
Dim Fd As String
Dim Fnm As String
Dim Retu As Long
Dim ItemX As String
Dim Var
Fd = ThisWorkbook.Path & "\"
Fnm = Dir(Fd & "*.xls*")
Do Until Fnm = ""
If Fnm <> ThisWorkbook.Name Then
Set Wb = Workbooks.Open(Fd & Fnm)
ItemX = Left(Wb.Name, InStr(1, Wb.Name, ".") - 1)
For Each Var In Wb.Worksheets
If Evaluate("=ISREF(" & Var.Name & "!A1)") Then
With Workbooks("集約.xlsm").Worksheets(Var.Name)
Retu = WorksheetFunction.Match(ItemX, .Rows(4), 0)
Var.Range("C5:C45").Copy .Cells(5, Retu)
End With
End If
Next
Wb.Close False
End If
Fnm = Dir()
DoEvents
Loop
End Sub
今から出かけますので対応は夕方以降になります。
他にたくさんすばらしい回答者の皆様もいらっし
ゃいますので。。。でわ m(_ _)m
（隠居じーさん） 2019/11/15(金) 12:52
たぶん、それぞれの構成、レイアウトは
データ側
シート構成
部長
係長1
係長2
各シートレイアウト
____B________C________
5 業務1 6:45
6 業務2 7:30
・ ・
・ ・
45 業務41 0:00
集計側（マクロもこちらに記述）
シート構成
部長
課長
係長
係長2
係員1
係員2
・
・
各シートレイアウト
____C________D______E______F_______
4 業務 福岡 佐賀 大分
5 業務1
6 業務2
・ ・
・ ・
45 業務41 0:00
みたいな感じになっているんじゃないですかね。
なので、集計用.xlsmは開いているのが前提として【福岡.xlsx】だけ処理しようと思ったら
(1)福岡.xlsxを開く (2)開いたブックのシートを巡回して (3)対象となったシートと同じ名前の集計用ブックのシートのうち、4行目が"福岡"のものを探して (4)対象シートのC5:C45をコピーして (5)対象となったシートと同じ名前の集計用ブックの、5行目、(3)の列に貼付 (6)(3)～(5)を福岡.xlsxの全シート分繰り返す (7)福岡.xlsxを保存せずに閉じる
という処理をすればよいように思います。
テストはしてないですが、たぶんこんな感じ。
Sub テキトー()
Const ブック名 As String = "福岡.xlsx"
Dim 県名 As String, 列 As Variant
Dim MySH As Worksheet, dstSH As Worksheet
With Workbooks.Open(ThisWorkbook.Path & "\" & ブック名)
県名 = Left(ブック名, InStrRev(ブック名, ".") - 1)
For Each MySH In .Worksheets
Set dstSH = ThisWorkbook.Worksheets(MySH.Name)
列 = Application.Match(県名, dstSH.Rows(4), 0)
If IsError(列) Then
MsgBox "県名検索エラー"
Exit Sub
End If
MySH.Range("C5:C45").Copy dstSH.Cells(5, 列)
Next MySH
.Close
End With
End Sub
で、↑の部分が作り込めたら、外側のループはこんな感じにすればよいとおもいます。
Sub 外側のループ()
Dim ブック名 As String
ブック名 = Dir(ThisWorkbook.Path & "\*.xls?")
Do Until ブック名 = ""
If ブック名 <> ThisWorkbook.Name Then
MsgBox ブック名 & " がみつかりました"
End If
ブック名 = Dir()
Loop
End Sub
どのくらい"至急"なのか知りませんが、これを理解してご自身のコードに取り込む時間がとれないなら、やはり外注すべきだとおもいます。
（もこな２ ） 2019/11/15(金) 13:32
（追い込まれびと） 2019/11/15(金) 13:47
（隠居じーさん） 2019/11/15(金) 15:18
研究材料として使って理解できた部分をご自身のコードに組み込むのであれば、ご自由にどうぞ。
（もこな２ ） 2019/11/15(金) 18:40
こんばんは ＾＾
これでなんとか。。。あっているかどうか解りませんが、
エラー処理は不完全なので、ま、参考程度におとどめく
ださいませ。。。m(_ _)m
Sub OneInstance()
Dim Wb As Workbook
Dim i As Long
Dim Fd As String
Dim Fnm As String
Dim Retu As Long
Dim ItemX As String
Dim Var As Variant
Dim Tmp As String
Fd = ThisWorkbook.Path & "\"
Fnm = Dir(Fd & "*.xls*")
Do Until Fnm = ""
If Fnm <> ThisWorkbook.Name Then
Set Wb = Workbooks.Open(Fd & Fnm)
ItemX = Left(Wb.Name, InStr(1, Wb.Name, ".") - 1)
For Each Var In Wb.Worksheets
On Error Resume Next
Tmp = Workbooks("集約.xlsm").Worksheets(Var.Name).Name
On Error GoTo 0
If Tmp <> "" Then
With Workbooks("集約.xlsm").Worksheets(Var.Name)
Retu = WorksheetFunction.Match(ItemX, .Rows(4), 0)
Var.Range("C5:C45").Copy .Cells(5, Retu)
End With
Else
MsgBox "集計に" & Var.Name & " シートが有りません" & Chr(13) & "作成後再実行してください"
Wb.Close
Set Wb = Nothing
Exit Sub
End If
Tmp = ""
Next
Wb.Close False
End If
Fnm = Dir()
DoEvents
Loop
Set Wb = Nothing
End Sub
（隠居じーさん） 2019/11/15(金) 19:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.