[[20200324190527]] 『2ファイル間で複雑な転記(コピペ)処理をしたい』(あめろ) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『2ファイル間で複雑な転記(コピペ)処理をしたい』(あめろ)

VBAの書き方で質問です。

Excelファイル1、2、3がそれぞれ違うフォルダにあり、
ファイル1のB2セルに、読み込みファイルとしてファイル2のファイル名まで指定したフォルダパス。B3セルに書き出しファイルとしてファイル3のファイル名まで指定したフォルダパスを設定し、マクロボタンを押下すると

ファイル2のセルB1:C1のどちらにもデータが入っていた場合のみ、ファイル2のB1:E1 〜B45:E45をファイル3のA1:C1〜A45:C45、H1〜H45(ファイル2のE列)に転記し、ファイル?AのセルB1:C1どちらかにデータが入っていなかった場合は飛ばしてB2:C2を見るような動きで、ファイル2のB45:E45まで繰り返し処理をする動きにしたいのですが、どう書けば良いでしょうか…
飛ばした場合もファイル3に空白行は作らないようにしたいです。
お詳しい方ご回答お願い致します!

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


まずは、ファイル1〜3を開いた状態で

>ファイル2のB1:E1 〜B45:E45をファイル3のA1:C1〜A45:C45、H1〜H45(ファイル2のE列)に転記し

これを、マクロの記録で確認してみてください。

(マナ) 2020/03/24(火) 20:09


すでにありました指摘に加えて、下記の明確化をしたらどうでしょう。

| ファイル2のセルB1:C1のどちらにもデータが入っていた場合のみ、
| ファイル2のB1:E1 〜B45:E45をファイル3のA1:C1〜A45:C45、H1〜H45(ファイル2のE列)に転記し
とあります。
(1)B1:C1のどちらにもデータが入っていたら、1行目から45行目のデータを対象とした転記をするのか、
それとも、
(2)各行毎に、B列C列をみて、どちらも入っている行だけに限定して、その行について転記をする
のか、どちらなのか明確でない印象です。
そこを明確にしたほうがよいと思います。

(γ) 2020/03/24(火) 20:35


>マナ様
コメントありがとうございます。
マクロの記録、失念しておりました。
明日転記動作を記録してみて、参考になるコードがないか確認してみます。
(あめろ) 2020/03/24(火) 21:03

>γ様
コメントありがとうございます。
文章が足らず申し訳ありません。
おっしゃる通り、(2)ファイル2の各行B列C列の両方にデータが入っていた場合のみ、
ファイル2のB1:E1を ファイル3のセルA1:C1、H1へ転記していく処理としていきたいです。
(あめろ) 2020/03/24(火) 21:04

おそらくマルチポストだと思われるmougのトピックは閉じたようですが解決したんでしょうか?
https://www.moug.net/faq/viewtopic.php?t=79261
解決したなら、こちらにもフィードバックするとともに解決した旨書いておいた方がよいです。

 【初めての方へ】より抜粋
 (n) [マルチポストについて] [multipost]

ちなみに、
>(2)ファイル2の各行B列C列の両方にデータが入っていた場合のみ、
>ファイル2のB1:E1を ファイル3のセルA1:C1、H1へ転記していく処理としていきたいです。
↑を

 ・ファイル2の1行目〜B列最終行までのうち、B列、C列の両方にデータが入っている行のみ
 ・ファイル2のB〜D列、E列 → ファイル3の【1行目から詰めて】A〜C列、H列となるようにコピペしたい

ってことだと解釈すると、

【1行ずつ処理】

    Sub さんぷる1()
        Dim srcSH As Worksheet
        Dim dstSH As Worksheet
        Dim i As Long, 出力行 As Long

        Set srcSH = Workbooks("ファイル2.xls").Worksheets(1)
        Set dstSH = Workbooks("ファイル3.xls").Worksheets(1)

        With srcSH
            For i = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row
                If .Cells(i, "B").Value <> "" And .Cells(i, "C").Value <> "" Then
                    出力行 = 出力行 + 1
                    .Range(.Cells(i, "B"), .Cells(i, "D")).Copy dstSH.Cells(出力行, "A")
                    .Cells(i, "E").Copy dstSH.Cells(出力行, "H")
                End If
            Next i
        End With
    End Sub

【まとめて処理】

    Sub さんぷる2()
        Dim srcSH As Worksheet
        Dim dstSH As Worksheet
        Dim i As Long
        Dim MyRNG As Range

        Set srcSH = Workbooks("ファイル2.xls").Worksheets(1)
        Set dstSH = Workbooks("ファイル3.xls").Worksheets(1)

        With srcSH
            For i = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row
                If .Cells(i, "B").Value <> "" And .Cells(i, "C").Value <> "" Then
                    If MyRNG Is Nothing Then
                        Set MyRNG = .Rows(i)
                    Else
                        Set MyRNG = Union(.Rows(i), MyRNG)
                    End If
                End If
            Next i

            If Not MyRNG Is Nothing Then
                Intersect(MyRNG, .Range("B:D")).Copy dstSH.Range("A1")
                Intersect(MyRNG, .Range("E:E")).Copy dstSH.Range("H1")
            End If

        End With
    End Sub

みたいな方法があると思いました。参考まで。

(もこな2) 2020/03/27(金) 04:11


コメント返信:

[ 一覧(最新更新順) ]


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