[[20180923025444]] 『日付に関連した別のファイルへの転記のVABについax(yusukejamu) ページの最後に飛ぶ

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

 

『日付に関連した別のファイルへの転記のVABについて』(yusukejamu)

VABについて、ほぼ初心者です。
日付に関連した転記について他の方が質問していましたが、
・別のファイルへの転記
・転記元のシートが増える
などの扱い方で相違点が多く、困難な状態にあります。
どうぞお力添えのほど、よろしくお願いいたします。

1.行いたい作業概要
・「記録表ファイル」を「実績管理表ファイル」に転記したいです。
・「記録表ファイル」と「実績管理表ファイル」はCドライブの別のフォルダにあります。
・「記録表ファイル」は、シートの名前を当日の日付として、1日に一つ作成します。
(実際には、「出来高18年09月18日」というシートの名前になります。その他に「作業時間」といったシートもあるため、区別のために日付の前に「出来高」と付けました)

2.転記元詳細
ファイル名:記録表
シート名:出来高18年09月18日
     出来高18年09月19日
     出来高18年09月20日
と毎日シートが増えます。

注記
1)シートを増やす理由は、現場で数字を記入する記録表として使用しているため、1日1枚で管理しています。シートを増やす必要がなければ、それでも結構です。

保存場所:C:\Users\yu\Desktop
シートの中身:

A   B     C     D      E    F
1  日付  2018.9.01

3  品目   規格    入数      出来高
4                   箱数   半端
5       L      6     3    1
6 リンゴ   L      8     4    5
7       M     10    10    3
8       M     12     5    6
9       L      8    10    5
10      L     10     8    5
11ブドウ   M     12    12    7
12      M     15    13    9
13

表の説明
・出来高の「箱数」と「半端」が空白なので、当日の出来高の数を手入力し、それらの数字を転記したいです。
・品目、規格、入数は3と4行のセルが結合されています。
出来高は、FとGのセルが結合されています。
リンゴはA5〜A8まで結合されています。
ブドウはA9〜A12まで結合されています。
入数とは、1箱の段ボールに入っている数です。
半端とは、1箱の規定数にならなかったため、半端となった商品数です。

3.転記先詳細
ファイル名:実績管理表(リンゴ)
      実績管理表(ブドウ)
シート名:出来高集計
保存場所:C:\Users\yu\Documents

注記
1)転記先は、品目によってファイルが分かれています。
  実際には9品目あります。したがって、転記先ファイルも9個あります。

実績管理表(リンゴ)のシートの中身:

 A   B    C    D   E     F  G    H   I 
1  
2                     9/1     9/2  ・・・
3  品目  規格   入数  単価   出来高    出来高
4                    箱数 半端  箱数 半端
5       L    6  1000   3  1
6 リンゴ   L    8  1300   4  5
7       M   10  1400  10  3
8       M   12  1600   5  6

・2行目に日付がEとFが結合されて右に月末まで並んでいます。
日付は2列が結合されています。
・出来高を入力するセル以外はすでに表記されています。
・転記元のB1の日付と同じ転記先の日付の列にその日の出来高(箱数と半端)の数を自動転記したいです。
・実績管理表(ブドウ)ファイルの出来高集計シートもA6がブドウになっていることや入数の数は異なりますが、日付や空欄の配置は同様の表となっています。

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


 確認ですけど、

 1、記録表ファイルの出来高の入力列は、本当にF・G列ですか?
    A列が品目なら、D・E列の間違いでは無いんですか?

 2、入力範囲は固定みたいですけど、規格と入数の並びは「実績管理表」と「記録表」とも例のように必ず同じになりますか?
    要はリンゴならE5〜F8を丸ごとコピペ、ブドウならE9〜F12を丸ごとコピペで良いのかどうかです。
    並びが違うならSUMIFなどで集計する必要があるので、どうなんでしょうか?

(sy) 2018/09/23(日) 09:32


大変失礼いたしました。

1.列の配置が間違っていました。
  ご指摘いただいた通りでございます。
  正しくは下記の通りです。

転記元

    A    B      C     D     E   
1  日付  2018.9.01

3  品目   規格    入数      出来高
4                   箱数   半端
5       L      6     3    1
6 リンゴ   L      8     4    5
7       M     10    10    3
8       M     12     5    6
9       L      8    10    5
10      L     10     8    5
11ブドウ   M     12    12    7
12      M     15    13    9

転記先
 

     A   B     C   D    E   F   G   H   
1  
2                     9/1     9/2    ・・・
3  品目  規格   入数  単価   出来高    出来高   ・・・
4                    箱数 半端  箱数 半端  ・・・
5 リンゴ   L    6  1000   3  1
6 リンゴ   L    8  1300   4  5
7 リンゴ   M   10  1400  10  3
8 リンゴ   M   12  1600   5  6

2.規格と入数の並びは同じになります。
  但し、転記先のD列に単価の列が挿入されています。
  単価は、固定値です(社内の生産金額を算出するためのものなので、変動はしません)。

以上、引き続きよろしくお願いいたします。

(yusukejamu) 2018/09/23(日) 15:18


 それぞれの管理表ファイルに以下のコードを貼付けて実行してみて下さい。

 Sub test()
    Dim sh1 As Worksheet, sh2 As Worksheet, i, k

    Const fPath As String = "C:\Users\yu\Desktop\"
    Const fName As String = "記録表ファイル.xlsx"

    Set sh1 = ThisWorkbook.Sheets("出来高集計")

    sh1.Range("E5").Resize(4, 1000).ClearContents
    For Each sh2 In Workbooks.Open(fPath & fName).Sheets
        If sh2.Name Like "出来高*年*月*日" Then
            i = Application.Match(CLng(CDate(Mid(sh2.Name, 4))), sh1.Range("2:2"), 0)
            If Not IsError(i) Then
                k = Application.Match(sh1.Range("A5").Value, sh2.Range("A:A"), 0)
                If Not IsError(k) Then sh1.Cells(5, i).Resize(4, 2).Value = sh2.Cells(k, "D").Resize(4, 2).Value
            End If
        End If
    Next sh2

 End Sub

(sy) 2018/09/23(日) 19:21


作成して頂き、誠に感謝申し上げます。
動作確認は明日、会社で行う予定です。

不明な点について下記しました。
ご教授いただけると幸いです。

質問1
sh1.Range("E5").Resize(4, 1000).ClearContents
このResizeにどういう意味があり、どういう処理をしているのかが分かりませんでした。

質問2
Mid(sh2.Name, 4)は転記元シート名から4つの文字数を返す関数だと思うのですが、どうして、文字数が4なのでしょうか?

質問3
If Not IsError(k) Then sh1.Cells(5, i).Resize(4, 2).Value = sh2.Cells(k, "D").Resize(4, 2).Value 
上記のResize(4, 2).Value = sh2.Cells(k, "D").Resize(4, 2).Valueの処理内容が分かりませんでした。

質問4
プログラムの右に動作内容を表記しましたが、正しいか、ご確認をお願いいたします。

Sub test()

    Dim sh1 As Worksheet, sh2 As Worksheet, i, k     ’変数宣言 sh1:転記先ワークシート、sh2:転記元ワークシート i:日付   k:品目

    Const fPath As String = "C:\Users\yu\Desktop\"  ’転記元パス参照
    Const fName As String = "記録表ファイル.xlsx"   ’転記元ファイル参照

    Set sh1 = ThisWorkbook.Sheets("出来高集計")    ’転記先シート名をsh1に格納

    sh1.Range("E5").Resize(4, 1000).ClearContents    ’転記先E5のセルサイズを変更して値と書式を消去
    For Each sh2 In Workbooks.Open(fPath & fName).Sheets  ’転記元のシートをsh2に格納
        If sh2.Name Like "出来高*年*月*日" Then       ’条件:転記元のシート名が出来高*年*月*日”の形式である場合
            i = Application.Match(CLng(CDate(Mid(sh2.Name, 4))), sh1.Range("2:2"), 0)  ’転記元の日付と同じ日付を転記先の2行目から検索して変数iに格納
                                            ’検索値:転記元ワークシートの日付を取得して数値変換して日付変換
                                                  ’範囲:転記先の2行目
                                             ’方法:一致
 If Not IsError(i) Then                                 ’エラー判定。エラーでなければ以下を実行
                k = Application.Match(sh1.Range("A5").Value, sh2.Range("A:A"), 0)  ’転送先のA5と同じ文字を転記元のA列から検索して変数kに格納
                If Not IsError(k) Then sh1.Cells(5, i).Resize(4, 2).Value = sh2.Cells(k, "D").Resize(4, 2).Value ’kがエラーでなければ、転記先の5行目のiの日付のセルに数値を入力。
            End If
        End If
    Next sh2

 End Sub

引き続きよろしくお願いいたします。

(yusukejamu) 2018/09/24(月) 02:32


 質問1
 Resizeに関しては、転記先の列が何列になるか分からなかったので、一応E列から1000列分を初期化しています。
 例えば列が最大でBB列までしか使用しないとかなら、sh1.Range("E5:BB8").ClearContents で良いです。
 何の為に初期化するのかは、説明の必要は無いですよね。

 質問2
 Mid(sh2.Name, 4)は4つの文字を返してるのではなく、左から4つ目の文字以降の全ての文字を返しています。
 例:シート名が「出来高18年09月24日」なら左から4つ目以降なので「18年09月24日」を返します。
 詳しくはワークシート関数のMID関数と同じなので、MID関数のヘルプを調べて下さい。
 唯一VBAでは第三引数の文字数の引数を省略可能と言う事だけが違いますが、それ以外は全て同じです。

 質問3
 それぞれ「i:日付の列」と「k:品名の行」の列番号や行番号が不定になるので、
 MATCH関数で見つかったセルから4行2列分のデータを転記しています。
 以下などで勉強して下さい。
https://excel-ubara.com/excelvba1/EXCELVBA382.html
http://www.excel-wing.com/study/jitumu/1409

 質問4
 だいたい合ってます。
 i:日付   k:品目 は、i:日付の列番号   k:品目の行番号 の方がより適切ですかね。
 後、 i = Application.Match(CLng(CDate(Mid(sh2.Name, 4))), sh1.Range("2:2"), 0)
 の ’検索値:転記元ワークシートの日付を取得して数値変換して日付変換
 は、処理の順番としては、
 1、MID関数で左から4文字以降の文字列取得(この段階ではただの文字) 
 2、CDate関数で日付に変換
 3、CLng関数でシリアル値に変換
 なぜ最後のシリアル値に変換するかは、VBAでは内部がおそらく英語バージョンなので、
 日付の表記が日本と違うために、日付のデータでは書式を英語圏の表記に合わせないと検索しても見つかりません。
 ですがCDate関数の戻り値は日本語書式の日付データなので、そのままではマッチしません。
 関数に限らず検索機能・置換機能なども同様で、VBA内で処理する検索に関する全ての事では日付は扱いが難しいんです。
 ですがシリアル値なら世界共通なので、書式に関係なく必ず見つかるので変換した方が扱いが簡単になります。

(sy) 2018/09/24(月) 08:12


ご質問に分かりやすく回答して頂き、理解が深まりました。

会社で試した結果、うまく転記することができて、思わず、声を発してしまい、大変感激した次第です。

このマクロでもとても時短になるのですが、当初は、転記元でマクロを1回実行することを想定していました。
なぜなら、転記元の品数が9品あり、転記先のファイルが9つに分かれているからです。

初めにお伝えするべきだったと至らなさを反省する次第です。
現状ですと各転記先ファイル各9個から、マクロを合計9回実行することになります。
何か、もっと簡潔にできる解決策がございましたらご教授お願いしたく存じます。

(yusukejamu) 2018/09/24(月) 22:33


 それはコードを全面的に修正する必要があるのでちょっと面倒くさいので、
 別に起動用のブックを用意して以下のコードを貼付けて実行して下さい。
 但しファイル名に全角半角問わず、Runで呼び出す時は()の記号は使えませんので、
 _アンダーバーなどに変えて下さい。
 (「実績管理表_リンゴ」のように変更して下さい。)
 (エラーにならない記号なら何を使用しても良いですけど、殆どの記号はエラーになると思います。)

 Sub test2()
    Dim wb As Workbook
    Dim fName As String

    Const fPath As String = "C:\Users\yu\Documents\"

    fName = Dir(fPath)
    Do Until fName = ""
        If fName Like "実績管理表*.xlsm" Then
            Set wb = Workbooks.Open(fPath & fName)
            Application.Run fName & "!test"
            wb.Save
            wb.Close
        End If
        fName = Dir()
    Loop

 End Sub

 でもこれ転記先のファイルを分ける意味はあるんですか?
 単にシートで分ければ良いような気がします。

(sy) 2018/09/24(月) 23:26


まだ、頂いたプログラムを実行する時間を作れていません。
今しばらくお待ちくださいますようお願いいたします。

先に転記先を分けている理由についてご説明いたします。

転記先ファイルは、9つに分かれているのですが、1つのファイルにつき、3つのシートがあります。
シート1
  総括を印刷するシートでA3サイズの中に表とグラフが各6個あります。
   データはシート2とシート3から集計したものがシート1に自動で表とグラフが作成されます。

シート2
 日付ごとに出来高と清算金額を算出しています。
シート3
日付ごとに各「収穫作業」、「播種作業」、「包装作業」、「梱包作業」で要した苗数やロスした苗数、梱包数、規格ごとの製品重量やごみ重量などを入力して収穫重量、製品重量などを算出しています。

このように各ファイルに3シートあるため、1ファイルにまとめると27シートにもなってしまうため、
初期の作成者が各商品ごとに分けたものと推測します。
初期の作成者は、VBAの知識はほどんどない方だったと聞いています。
当方も転送先ファイルを1つにして、9つのファイルで管理すれば良いと感じておりますが、かなりの作業量になるので、当方も実行に至っておりません。

(yusukejamu) 2018/09/27(木) 20:00


コメント返信:

[ 一覧(最新更新順) ]


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