[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『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 >
>ファイル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
【初めての方へ】より抜粋
(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.