[[20080715113137]]　『データの貼り付け２』（おでん）　ページの最後に飛ぶ

『データの貼り付け２』（おでん）

 以前に『データの貼り付け』で質問をしました。
 見積作成について、材料ファイルで拾った材料を、見積ファイルに貼り付けるようにしたいという内容です。
 追加でまた質問があります。どなたか宜しくお願い致します。

 下記は最後に回答頂いたコードです。

 '------
Sub 見積()
Dim i As Integer, xr As Integer, sr As Integer, sk As Long
Dim tbl1, tbl2, x, fn, mfn
    With Workbooks("見積書.xls").Sheets("材料ファイル")
        fn = .Range("A2").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 1)
    End With
    With Workbooks("見積書.xls").Sheets("見積")
        .Cells.ClearContents
        .Range("B1:J1") = Array("材料", "", "材料2", "", "", "数量", "単位", "単価", "金額")
    End With
    For Each mfn In fn
        With Workbooks(mfn & ".xls").Sheets("材料")
            tbl1 = .Range("A2:I89")
            tbl2 = .Range("K74:P89")
        End With
        ReDim x(1 To 89, 1 To 9)
        For i = 1 To 87     '材料（左側）
            If tbl1(i, 6) > 0 Then
                xr = xr + 1
                    x(xr, 1) = tbl1(i, 1)   '材料
                    x(xr, 3) = tbl1(i, 3)   '材料2
                    x(xr, 4) = tbl1(i, 4)   '（備考）
                    x(xr, 6) = tbl1(i, 6)   '数量
                    x(xr, 7) = tbl1(i, 7)   '単位
                If tbl1(i, 6) <> 1 Then
                    x(xr, 8) = tbl1(i, 8)   '単価
                End If
                    x(xr, 9) = tbl1(i, 9)   '金額
            End If
        Next
                xr = xr + 1
                    x(xr, 1) = "小計"
                    x(xr, 9) = tbl1(87, 9) '材料合計

                xr = xr + 1
                    x(xr, 1) = "人件費"
                    x(xr, 6) = "1"
                    x(xr, 7) = "式"
                    x(xr, 9) = tbl2(1, 5)   '人件費

        For i = 2 To 11     '材料（右側）
            If tbl2(i, 2) > 0 Then
                xr = xr + 1
                    x(xr, 1) = tbl2(i, 1)   '材料
                    x(xr, 6) = tbl2(i, 2)   '数量
                    x(xr, 7) = tbl2(i, 3)   '単位
                    x(xr, 9) = tbl2(i, 5)   '金額
                sk = sk + tbl2(i, 5)
            End If
        Next

                xr = xr + 1
                    x(xr, 1) = "小計"
                    x(xr, 9) = tbl2(1, 5) + sk  '人件費等合計

        For i = 12 To 14     '諸経費
            If tbl2(i, 1) <> "" Then
                xr = xr + 1
                    x(xr, 1) = tbl2(i, 1)
                    x(xr, 6) = "1"
                    x(xr, 7) = "式"
                    x(xr, 9) = tbl2(i, 5)   '諸経費
            End If
        Next

                xr = xr + 1
                    x(xr, 1) = "合計"
                    x(xr, 9) = tbl2(16, 5)  '合計

         With Workbooks("見積書.xls").Sheets("見積")
            sr = sr + 2
            .Range("B" & sr).Value = mfn
            .Range("B" & sr + 1).Resize(xr, 9) = x
            sr = sr + xr
         End With

        xr = 0
        sk = 0
    Next

    Workbooks("見積書.xls").Sheets("見積").Copy
End Sub
 '------

 上記のコードを実行すると、
 材料ファイルの材料シートの数量が0以上ところが、見積ファイルの見積シートに順に
貼り付いていってくれます。

 質問です。材料ファイルが多くなる見積には見積書の明細の１ページ目に項目ごとの合計が欲しいのです。
 そのコードを足したいのですが、どうすればいいでしょうか？

 　　　　　B　　　　　　　 　　D  　    G　 　H　　 I　　 J
 1　　　材料1　　　　　　　　材料2　　 数量　単位　単価　金額
 2　夏休みパーティーセット
 3  食パンサンドウィッチ　　　      　  1　　 式　　　 　1,500
 4  玄米パンサンドウィッチ　　　　　　　1　　 式　　　　 2,500　
 5　フランスパンサンド　　　　　　　　　1　　 式　　　　 1,200　
 6　サーモンベーグルサンド　　　　　　　1　　 式　　　　 1,800
 7
 8　合計　　　　　　　　　　　　　　　　　　　　　　　　 7,000

 上記のように作成したいです。B2にはその見積名を入れるようにし(これは手入力でも構いません)
 B3から合計金額を貼り付け、最後に総合計を出したいです。
 宜しくお願い致します。

[[20080610091745]]　『データの貼り付け』（おでん）

 少々きついことを書きます。
 前回
 >また教えて頂けませんか。
 >改造のことまで考えてくださって嬉しいです、自分で理想に近づけられるようにコードをゆっくり眺めてみます。
 かのようにおっしゃってました。

 で、
 その１ヵ月後に、努力のそぶりが見られないわけですが・・・。
 BJ

 BJ様、アドバイスありがとうございます。
 そぶり、そうですか。
 現在はもらったコードのまま使用している訳ではないのですが、
 質問の際には丁寧にくださった回答が参考になると思いこのような形で質問をさせて頂きました。
 1ヶ月後に自分の思い通りに操作できればいいんですけど...
 そううまく行かないのでこちらを利用し、1ヶ月で努力の結果がでるような方々から回答を待っている私です。

 >材料ファイルが多くなる見積
 ”多く”と言うのが少し疑問に感じました。（いくつと決まっているのか？）
 前回の質問はさ～っとしか見てないので、そのせいかな？

 >1ヶ月で努力の結果がでるような方々から回答を待っている
 とは、回答者の１ヶ月の努力と言う事？
 (蕎麦)

 1ヶ月で努力の結果が出せるような（デキる）方々から回答（解答）を待っている
 　　　　　　　　　 ^^^^^^
 という事ではないかと…
 でもカチンときたにしろ、言い方はマズイですね；
 そして質問も、質問というより丸投げでは…？
 「ここをこうしてこんな風にうまくいかない」と質問の形なら
 少しの努力が垣間見えるのに、それを書かないと努力が伝わりませんよ…？
 （私も勉強中）

 蕎麦様、返信ありがとうございます。
 多くというのは数が決まっている訳ではありません。
 毎回違います。多いと90数箇所になります。

 そして私の1ヶ月の努力と言うことではありません。私も勉強中様が返信をくださったように
 私には1ヶ月で自分の疑問の答えを出すことができなかったので、質問しました。

 私も勉強中様、返信ありがとうございます。
 そうですね目を通して下さる方々に失礼しました。
「ここをこうして～」なんてとこまでもいかなかったんです。
 一からテキストに目を通しても、前回答えを頂いた内容を理解するのが精一杯でした。
 ただ、理想だけ高くなってしまったんです。
 ということで、私の書き込みは趣旨が違ってきてますね。乱暴でした。

 >そして質問も、質問というより丸投げでは…？

 ここはほんんど丸投げだから、いいんでないの。
 回答者も、せっせとコード書いてくれるし。

 (時々質問者)

 >回答者も、せっせとコード書いてくれるし。
 それをせっせとメモってます。
 (蕎麦)

 >>材料ファイルが多くなる見積には
 >蕎麦様、返信ありがとうございます。
 >多くというのは数が決まっている訳ではありません。
 >毎回違います。多いと90数箇所になります。
 ”多くなる”と言うのをどこで線引きするのかを、聞いてみたのでした。
 複数が条件なのか、何枚以上とか決めているのか？
 (蕎麦)

 時々質問者様、返信ありがとうございます。
 回答者の方達、凄いですよね。
 他の質問を見ていても、よく的を得た答えを出してくれるなぁと驚きます。
 作業の効率が一気に上がるので、質問してる側からは大変ありがたいんですよね^^;

 蕎麦様、返信ありがとうございます。
 枚数というのが見積書の枚数ということであれば...箇所によって材料が変わりますので、
 見積書の枚数は変わってきます。
 見積書は1ページで18行あります。
 5行で見積書が終わってしまう箇所もあれば、40行使う箇所もあります。
 今の所、100箇所を越えたことはありませんので、100箇所以下。でしょうか。
 見積書のページ数に制限はありません。
 (おでん)

 ＞現在はもらったコードのまま使用している訳ではないのですが、
 ＞・・・・
 ＞多いと90数箇所になります。
 ってことは、Open-Close 辺りは入れておられるのですかね。

 ＞１．材料ファイルが全て開いている事
 の縛りを入れたのは、私ですが。（笑）

 さて、この流れからコードを載せるのも憚られるのですが
 かといって、前回の改造から何とか成りそうな問題でもなさそうですので
 イメージが合っているなら　と言うことで・・・。

 見積書ブックには、もう一つ「見積合計」シートを作成してください。
 また、書式設定（J列の桁区切り等）は事前に行っておいて下さい。

 見積合計シートの、B2セルには
 該当ブックのブック名を表示させる関数を入力する様に成っています。
 この関数は、ブックが保存された後に計算された時に　ブック名を返します。
 それまでは、#VALUE!エラーが表示されます。

 見積書の名前とブック名が一致しない場合は、
 B2セルに数式を書き込む行を削除して使用して下さい。

 また、前回の物と比べて　格段に時間がかかる様で有れば
 今　その都度セルに書き出していますが
 配列に書き込んで行った方が良いのかもしれません。

 '------
Sub 見積()
Dim i As Integer, xr As Integer, sr As Integer, mr As Integer
Dim sk As Long, mk As Long
Dim tbl1, tbl2, x, fn, mfn, m
    With Workbooks("見積書.xls")
        With .Sheets("材料ファイル")
            fn = .Range("A2").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 1)
        End With
        With .Sheets("見積合計")
            .Cells.ClearContents
            .Range("B1:J1") = Array("材料1", "", "材料2", "", "", "数量", "単位", "単価", "金額")
            .Range("B2").Value = _
                "=MID(CELL(""filename"",R1C1),FIND(""["",CELL(""filename"",R1C1))+1,FIND(""]"",CELL(""filename"",R1C1))-FIND(""["",CELL(""filename"",R1C1))-5)"
            .Range("B3").Resize(UBound(fn, 1), 1) = fn
            ReDim m(1 To UBound(fn, 1), 1 To 4)
        End With
        With .Sheets("見積")
            .Cells.ClearContents
            .Range("B1:J1") = Array("材料1", "", "材料2", "", "", "数量", "単位", "単価", "金額")
        End With
    End With
    For Each mfn In fn
        With Workbooks(mfn & ".xls").Sheets("材料")
            tbl1 = .Range("A2:I89")
            tbl2 = .Range("K74:P89")
        End With
        ReDim x(1 To 89, 1 To 9)
        For i = 1 To 87     '材料（左側）
            If tbl1(i, 6) > 0 Then
                xr = xr + 1
                    x(xr, 1) = tbl1(i, 1)   '材料
                    x(xr, 3) = tbl1(i, 3)   '材料2
                    x(xr, 4) = tbl1(i, 4)   '（備考）
                    x(xr, 6) = tbl1(i, 6)   '数量
                    x(xr, 7) = tbl1(i, 7)   '単位
                If tbl1(i, 6) <> 1 Then
                    x(xr, 8) = tbl1(i, 8)   '単価
                End If
                    x(xr, 9) = tbl1(i, 9)   '金額
            End If
        Next
                xr = xr + 1
                    x(xr, 1) = "小計"
                    x(xr, 9) = tbl1(87, 9) '材料合計
                xr = xr + 1
                    x(xr, 1) = "人件費"
                    x(xr, 6) = "1"
                    x(xr, 7) = "式"
                    x(xr, 9) = tbl2(1, 5)   '人件費
        For i = 2 To 11     '材料（右側）
            If tbl2(i, 2) > 0 Then
                xr = xr + 1
                    x(xr, 1) = tbl2(i, 1)   '材料
                    x(xr, 6) = tbl2(i, 2)   '数量
                    x(xr, 7) = tbl2(i, 3)   '単位
                    x(xr, 9) = tbl2(i, 5)   '金額
                sk = sk + tbl2(i, 5)
            End If
        Next
                xr = xr + 1
                    x(xr, 1) = "小計"
                    x(xr, 9) = tbl2(1, 5) + sk  '人件費等合計
        For i = 12 To 14     '諸経費
            If tbl2(i, 1) <> "" Then
                xr = xr + 1
                    x(xr, 1) = tbl2(i, 1)
                    x(xr, 6) = "1"
                    x(xr, 7) = "式"
                    x(xr, 9) = tbl2(i, 5)   '諸経費
            End If
        Next
                xr = xr + 1
                    x(xr, 1) = "合計"
                    x(xr, 9) = tbl2(16, 5)  '合計

                mr = mr + 1
                m(mr, 1) = "1"
                m(mr, 2) = "式"
                m(mr, 4) = tbl2(16, 5)      '合計
                mk = mk + tbl2(16, 5)       '合計

        With Workbooks("見積書.xls")
            With .Sheets("見積")
               sr = sr + 2
               .Range("B" & sr).Value = mfn
               .Range("B" & sr + 1).Resize(xr, 9) = x
               sr = sr + xr
            End With
        End With
        xr = 0
        sk = 0
    Next

    With Workbooks("見積書.xls")
        With .Sheets("見積合計")
            .Range("G3").Resize(mr, 4) = m
            mr = mr + 2
            .Range("B" & mr + 2).Value = "合計"
            .Range("J" & mr + 2).Value = mk
        End With
        .Sheets(Array("見積合計", "見積")).Copy
    End With
End Sub

 (HANA) 見積合計を、配列処理に変更しました。

 HANA様、ありがとうございます！
 返信遅くなりました。

 そうなんです、全部のファイルを開けているという条件だと、う、動くかな、どうしようって思ってました。
 が、残念ながらOpen-Closeは入っていません。ヒントありがとうございます！
 90箇所以上と言うのは多くないんですが、そんな作業の時こそありがたく感じます。
 理想通りです。本当凄いです。

 >見積書の名前とブック名が一致しない場合は、
 >B2セルに数式を書き込む行を削除して使用して下さい。

 いえいえ、とっても助かります(涙)
 頭で考えてることが何でもできるんですね。凄いですね。

 今回、私にとってはとてもラッキーな出来事でした。
 自分で言っていることが、どれくらいの知識と技術が必要かも分かっていないのです。
 それに気付かせてもらうこともできました、遅い時間にありがとうございました。

 (おでん)

 そうですね・・・。
 私も前回の事が有りましたのでコードを載せましたが
 いつもなら、私が真っ先にBJさんが書いて居られるコメントを
 書いているところです。

 なかなか「自分は頑張ってますよ」をアピールするのは
 難しいですけどね・・・・
 せっかくやって居られるのですから
 ちゃんと書いて於くのが良いと思いますよ。
 そんな事で、レスの付き方も変わってくると思います。

 Open-Close に関しては過去ログにも有ると思いますし
 単純に　開いたり閉じたりするだけのコードで有れば
 記録からも得られると思います。
 詳細は調べてみてください。

 開いたブック（一つの材料ブック）に関する処理は
 ＞       With Workbooks(mfn & ".xls").Sheets("材料")
 ＞           tbl1 = .Range("A2:I89")
 ＞           tbl2 = .Range("K74:P89")
 ＞       End With
 この部分に集めてありますので　この部分の上で開き
 下側で閉じてもらえば良いと思います。

 昨夜は
 ＞今　その都度セルに書き出していますが
 ＞配列に書き込んで行った方が良いのかもしれません。
 で終わっていましたが、今後を見据えて　やはり配列に入れておきます。

 上記コードを直接変更しましたので　再度貼り付け直してください。

 「Open - Close させながら快適に動いてます！！」
 と言う書き込みを　お待ちしております。

 (HANA)

 HANA様へ。

 出来上がってみたら、なぜこの2行を入れるのにこんなに悩んだんだ私...
 と落ち込みましたが、現在Open - Closeさせながら動いております！！

 For Each mfn In fn
        Workbooks.Open Filename:=(mfn & ".xls")
        With Workbooks(mfn & ".xls").Sheets("材料")
            tbl1 = .Range("A2:I89")
            tbl2 = .Range("K74:P89")
            Workbooks(mfn & ".xls").Close False
            End With

 今のところ上記のコードで問題はないんですけど^^;
 ということで、まず一段落です。本当にありがとうございました。
 (おでん)

 出来ましたか。良かったです。

 ＞出来上がってみたら、なぜこの2行を入れるのにこんなに悩んだんだ私...
 最初はそんな物だと思いますよ。
 でも、次から同じ様なパターンが出てきたときは
 今回悩んだ事が生きてくると思います。

 上記のコードで問題無いのですが、一つだけ。
 With ○○ ～ End With　と有った場合
 その間に出てくる　「.」で始まる前に
 ○○が付いている事を表します。

 今回の場合だと ○○ の部分は「Workbooks(mfn & ".xls").Sheets("材料")」
 ですから、Withを使わずに書くと
    For Each mfn In fn
        Workbooks.Open Filename:=(mfn & ".xls")
            tbl1 = (mfn & ".xls").Sheets("材料").Range("A2:I89")
            tbl2 = (mfn & ".xls").Sheets("材料").Range("K74:P89")
            Workbooks(mfn & ".xls").Close False
 です。
 この状態から With でくくると
    For Each mfn In fn
        Workbooks.Open Filename:=(mfn & ".xls")
        With Workbooks(mfn & ".xls").Sheets("材料")
            tbl1 = .Range("A2:I89")
            tbl2 = .Range("K74:P89")
        End With
        Workbooks(mfn & ".xls").Close False
 この様になるのが自然な印象が有りませんか？

 ・・・単なる「印象」でCloseが　End With の前にあっても
 問題が有る訳ではないのですが。

 With ～ End With がひとくくりなのですから
 Open → Close と言う一連の作業は
 ひとくくりの中に入れるか、ひとくくりの外に出しておくか
 どちらかにして於いた方が、後で分かりやすいように思います。

 　ブックを開く。
 　開いたブックに関して処理を行い、
 　開いたブックに関しての処理が終わったら。
 　ブックを閉じる。
 と言ったイメージです。

 現在の物ですと
 　ブックを開く。
 　開いたブックに関して処理を行い、
 　ブックを閉じる。
 　開いたブックに関しての処理を終了。
 の様な流れに成っている様に思います。

 あくまでも「印象」であって、
 「致命的なこと」ではありませんが。

 (HANA)

 HANA様、大変返信遅くなりました、すいません。

 頂いたヒントでとりあえず動いた！間違えてなかったみたいだ。
 て所までしか辿り着いていませんでしたので、説明していただいて気付けました。
 意味を知って作業するのと、そうでないのとでは、自分の中のスッキリ度も全然違ってきます。
 ありがとうございました。

 (おでん)

コメント返信：

[ 一覧(最新更新順) ]

[[20080715113137]] 『データの貼り付け２』（おでん） ページの最後に飛ぶ

[[20080715113137]]　『データの貼り付け２』（おでん）　ページの最後に飛ぶ