[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA 転記作業』(アイアン)
こんばんわ。
VBAの転記作業にてお聞きしたいです。
以下のコードで抽出条件を絞って抽出までは出来ました。
Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim OpenFileName As String, fileName As String, Path As String, SetFile As String Dim wbMoto, wbMoto1, wbSaki As Workbook Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット Set wbMoto1 = ActiveWorkbook CreateObject("Wscript.shell").currentdirectory = "C:\Users\***\Desktop\リスト"
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx?") 'ダイアログボックスを表示して、マスターデータファイルを指定します。
If OpenFileName <> "False" Then Set wbSaki = Workbooks.Open(fileName:=OpenFileName, ReadOnly:=False, UpdateLinks:=0)
Dim maxRow As Long maxRow = Cells(Rows.Count, 1).End(xlUp).Row
'ワークブック間のシート「項目」をコピーします。
wbSaki.Worksheets(1).Range("B6:AJ359"). _ AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wbMoto.Worksheets("作業用").Range("A1:B2"), _ CopyToRange:=wbMoto.Worksheets("").Range("D1:F150"), Unique:=False wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub もうひとつ条件にセルの数値が-(マイナス)のものだけを抽出するにはどうしたらよいでしょうか?
続きまして
仮に抽出できたとして、これを再度、取り込んだ先のファイルに転記する作業を教えてほしいです。
作業手順は
A ダイアログで転記したいファイルを選ぶ
B 前文の抽出条件(AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wbMoto.Worksheets("作業用").Range("A1:B2"))
で転記先を絞り込む
C シート名:作業用のD2セルと同じものを転記したいファイルのB列の中から探しだしあったらート名:作業用のD2セルの一つ右のセルの値を転記したいファイルの見つかったセルの2つ右のセルに転記する
D Cの内容をD2セルを始点としてD列のセルが入力されている最終行まで繰り返す。
以上のコードはどの用に書いたらいいでしょうか?
説明がいまいちで申し訳ございません。
よろしくお願いいたします。
< 使用 Excel:Excel2019、使用 OS:Windows10 >
■1
↓の狙いはなんですか?
Set wbMoto = ActiveWorkbook Set wbMoto1 = ActiveWorkbook
■2
>セルの数値が-(マイナス)のものだけを抽出するにはどうしたらよいでしょうか?
フィルタオプションの条件に0未満を加えればよいです。
■3
>Cの内容をD2セルを始点としてD列のセルが入力されている最終行まで繰り返す。
ちょっと意味がわかりません。
行列の情報付きで、データと完成予定のレイアウトを示せませんか?
(もこな2 ) 2022/06/22(水) 20:30
Set wbMoto = ActiveWorkbook Set wbMoto1 = ActiveWorkbook →Set wbMoto1 = ActiveWorkbookはいりませんでした。 似たようなVBAから転用したため見逃していました。 ■2 >セルの数値が-(マイナス)のものだけを抽出するにはどうしたらよいでしょうか? フィルタオプションの条件に0未満を加えればよいです。 →AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wbMoto.Worksheets("作業用").Range("A1:B2"), _の次に加えればよろしいですか? ちょっと調べてみます。 作業シート D列 E列 行 2 A 100 3 B 200 4 C 500 5 D 510 6 E 250 7 F 200 8 G 211 9 H 25 10 I 26 11 J 27 この例を元に説明します 転記先ファイルをダイアログで選びます 抽出条件はAdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wbMoto.Worksheets("作業用").Range("A1:B2")で抽出します。 上の例だとD2セルにはAが入っています。 この値と同じものを転記先ファイルのB列から探し出し、見つかったら 作業シートのD2セルの右隣E2セルの100を転記先ファイルのB列で見つかったセルの右に2つ先(D列)のセルに転記します。 この作業をD列の最終行(例だと11行)まで繰り返します。 こんな感じです大丈夫でしょうか? (アイアン) 2022/06/22(水) 20:56
※既に承知しているということなら失礼。
■5
>こんな感じです大丈夫でしょうか?
ちょっと聞き方がよくなかったです。
行列の情報付きで、【データ側】と【抽出されたデータ】の情報を示してくださいという意味でした。
例えば↓のように説明することはできますか?
【データ側】 __D__ __E__ __E__ ... __AJ_ 1 項目1 項目2 項目3 項目35 2 A 123 AAA BBB 3 A -14 AAA BBB 4 B 123 AAA BBB 5 B 123 AAA BBB 6 A -8 AAA BBB 7 C 123 AAA BBB 8 D -11 AAA BBB 9 A 0 AAA BBB 10 C -33 AAA BBB
【抽出結果】 __D__ __E__ __F__ 1 項目1 項目2 項目35 2 A -14 BBB 3 A -8 BBB 4 C -33 BBB
なお、今回のケースでは作業用シートのレイアウトも提示してください。
(フィルタオプションをそのものを調べれば解決しそうな気もしますが)
(もこな2) 2022/06/22(水) 21:20
もこな2さん 0未満は解決しました。新たに作業用シートC2セルに<0を加えました 説明します。 【転記先ファイル】 __B__ __D__ __E_ ... __AJ_ 1 項目1 項目2 項目3 項目35 2 A 123 BBA 3 B -14 BBA 4 C -123 BBA 5 D -15 BBA 6 A -8 BBB 7 B 123 BBB 8 C -11 BBB 9 E 0 BBB 10 F -33 BBB を作業シートのA1:C2セルを条件に抽出すると 【作業用シートに対する抽出結果】 __D__ __E__ __F__ 1 項目1 項目2 項目3 2 B -14 3 C -123 4 D -15 となります。 これで抽出のVBAは終了 別のVBAにて作業シートの項目2に値を書き込みます。(今回の事例とは関係ないので省略します。 そうすると 【作業用シートに対する項目2へ書き込み結果】 __D__ __E__ __F__ 1 項目1 項目2 項目3 2 B 100 -14 3 C 150 -123 4 D 200 -15 を元に転記先ファイルが 【転記先ファイル】 __B__ __D__ __E_ ... __AJ_ 1 項目1 項目2 項目3 項目35 2 A 123 BBA 3 B 100 -14 BBA 4 C 150 -123 BBA 5 D 200 -15 BBA となるのが完成形です。 (アイアン) 2022/06/22(水) 21:52
1.【データのあるシート】のレイアウト 2.【抽出条件があるシート】のレイアウト 3.【抽出結果】のレイアウト
それぞれを書いていただかないとよくわかりません。例えば
【データのあるシート】
__B__ __D__ __E_ ... __AJ_ 1 項目1 項目2 項目3 項目35 2 A 123 BBA 3 B -14 BBA 4 C -123 BBA 5 D -15 BBA 6 A -8 BBB 7 B 123 BBB 8 C -11 BBB 9 E 0 BBB 10 F -33 BBB
【抽出条件があるシート】
__A__ __B__ __C__ 1 項目1 項目1 項目3 2 <>A <>F <0
【抽出結果】
__D__ __E__ __F__ 1 項目1 項目2 項目3 2 B -14 3 C -123 4 D -15 5 C -11
みたいに説明できませんか?
■7
追加質問のほうはおそらく以下のような話だと思うんですが、
【抽出結果】を加工したデータ __D__ __E__ __F__ 1 項目1 項目2 項目3 2 B 100 -14 3 C 150 -123 4 D 200 -15 5 C 250 -11
項目2のデータを↓のように反映させたい
【抽出元となったシート】 __B__ __D__ __E_ ... __AJ_ 1 項目1 項目2 項目3 項目35 2 A 123 BBA 3 B 100 -14 BBA 4 C 150 -123 BBA 5 D 200 -15 BBA 6 A -8 BBB 7 B 123 BBB 8 C 250 -11 BBB 9 E 0 BBB 10 F -33 BBB
【抽出元となったシート】の元々の行がわかる情報がないと難しいと思います。
なので↓のように【元々の行が特定できるデータを追加】すれば、SUMIF関数などで対応ができるようになるとおもいます。
【データのあるシート】
__A__ __B__ __D__ __E_ ... __AJ_ 1 No. 項目1 項目2 項目3 項目35 2 1 A 123 BBA 3 2 B -14 BBA 4 3 C -123 BBA 5 4 D -15 BBA 6 5 A -8 BBB 7 6 B 123 BBB 8 7 C -11 BBB 9 8 E 0 BBB 10 9 F -33 BBB
↓
【抽出結果】 __A__ __B__ __C__ __D__ 1 No. 項目1 項目2 項目3 2 2 B -14 3 3 C -123 4 4 D -15 5 7 C -11
↓
【抽出結果の加工後】 __A__ __B__ __C__ __D__ 1 No. 項目1 項目2 項目3 2 2 B 100 -14 3 3 C 150 -123 4 4 D 200 -15 5 7 C 250 -11
↓
【項目2を元データに反映】
__A__ __B__ __D__ __E_ ... __AJ_ 1 No. 項目1 項目2 項目3 項目35 2 1 A 123 BBA 3 2 B 100 -14 BBA ←「No.」を手掛かりに 「項目2」の(合計)値を求めている 4 3 C 150 -123 BBA ←「No.」を手掛かりに 「項目2」の(合計)値を求めている 5 4 D 200 -15 BBA ←「No.」を手掛かりに 「項目2」の(合計)値を求めている 6 5 A -8 BBB 7 6 B 123 BBB 8 7 C 250 -11 BBB ←「No.」を手掛かりに 「項目2」の(合計)値を求めている 9 8 E 0 BBB 10 9 F -33 BBB
ただ、その場合、今回とは関係ないとおっしゃるマクロで直接元データを弄ったほうが、話が早いといったことはないのでしょうか?
(もこな2 ) 2022/06/23(木) 19:59
__B__ __D__ __E_ ... __AJ_ 1 項目1 項目2 項目3 項目35 2 A 123 BBA 3 B -14 BBA 4 C -123 BBA 5 D -15 BBA 6 A -8 BBB 7 B 123 BBB 8 C -11 BBB 9 E 0 BBB 10 F -33 BBB
【VBAが組み込まれているファイルの抽出条件があるシート(シート名は作業用シート)】
__A__ __B__ __C__ 1 項目1 項目1 項目3 2 TOP BBA <0
【VBAが組み込まれているファイルに対する抽出結果のレイアウト(シート名は作業用シート)】
__D__ __E__ __F__ 1 項目1 項目2 項目3 2 B -14 3 C -123 4 D -15 となります。 ■7の抽出結果を再度、転記する話ですが、再度説明いたしますことご容赦ください
【VBAが組み込まれているファイルに対する抽出結果のレイアウト(シート名は作業用シート)】
に項目2に値がはいった場合のレイアウト
__D__ __E__ __F__ 1 項目1 項目2 項目3 2 B 100 -14 3 C 150 -123 4 D 200 -15 VBAが組み込まれているファイルの抽出条件があるシート(シート名は作業用シート)】 __A__ __B__ 1 項目1 項目1 2 TOP BBA を抽出条件として 【転記先ファイルのデータのあるシートに転記した際のレイアウト(シート場所は必ず一番左】 __B__ __D__ __E_ ... __AJ_ 1 項目1 項目2 項目3 項目35 2 A 123 BBA 3 B 100 86 BBA 4 C 150 27 BBA 5 D 100 85 BBA 6 A -8 BBB 7 B 123 BBB 8 C -11 BBB 9 E 0 BBB 10 F -33 BBB 項目3には項目2-項目4(表示はしていないが必要数が入っています)の数式が入っています。
抽出結果の項目1のセルを転記先ファイルの項目1の列から探し、あったら抽出結果の項目2のセルを
転記先ファイルの項目2に転記する
今回のレイアウトだと抽出結果のレイアウトの4行目まで行うことになりますが、行う回数はバラバラですので抽出結果のレイアウトの項目1の列の文字が入っている最終行まで繰り返します。
この内容をVBAで実現出来たらいいなと思っています。
毎回転記元のファイル名は変わります。
VBAが組み込まれているファイルは固定です。
伝わったでしょうか?
最後に
ただ、その場合、今回とは関係ないとおっしゃるマクロで直接元データを弄ったほうが、話が早いといったことはないのでしょうか?
に対する回答をします。
そのマクロ自体は関係ないです。
マクロの内容は
【VBAが組み込まれているファイルに対する抽出結果のレイアウト(シート名は作業用シート)】
に項目2に値がはいった場合のレイアウト
__D__ __E__ __F__ 1 項目1 項目2 項目3 2 B 100 -14 3 C 150 -123 4 D 200 -15 の項目2にひとつずつ転記するマクロです。 1個ずつユーザーフォームにて項目1の内容(例:B)を入力して 次のユーザーフォームにて個数(例:100) を入力して、レイアウトの項目2に転記する このマクロはまだ思想の段階でくんでいません。
こんな感じです
(アイアン) 2022/06/23(木) 21:05
__A__ __B__ __C__ 1 項目1 項目1 項目3 2 TOP BBA <0
↑ですと↓のような条件になりますから、どのデータも抽出されないかとおもいます。
・【項目1】が"TOP"か"BBA" ・【項目3】が0未満
■9
>抽出結果の項目1のセルを転記先ファイルの項目1の列から探し、あったら抽出結果の項目2のセルを
転記先ファイルの項目2に転記する
>今回のレイアウトだと抽出結果のレイアウトの4行目まで行うことになりますが、行う回数はバラバラですので抽出結果のレイアウトの項目1の列の文字が入っている最終行まで繰り返します。
↑も理解できません。
具体的に行列の情報付きでサンプルデータを示せませんか?
■10
>そのマクロ自体は関係ないです。
関係ないとのことなので違うのかもしれませんが、私には元データをいじりたいように見えたので、私にはフィルタオプションではなく、オートフィルタなので抽出してデータを直接いじったほうが良いのではないかと思った次第です。
■11
いずれにせよ、ちょっと私には状況やりたいことがピンときていないので、勘の鋭い回答者さんの登場を待たれるのも手かもしれません。
お役に立てずすみません。
(もこな2) 2022/06/24(金) 07:59
条件設定が正確で、結果の正当なことが確認できていれば、
マクロにするのは負荷はほとんどありません。
手作業でできてから、その次のステップで考えれればよいでしょう。
# 同趣旨のコメントで恐縮です。
(γ) 2022/06/24(金) 08:27
誤 ・【項目1】が"TOP"か"BBA" 正 ・【項目1】が"TOP"かつ"BBA"
誤 オートフィルタなので抽出 正 オートフィルタなどで抽出
誤 状況やりたいこと 正 状況・やりたいこと
他にもあるかもしれません。
(もこな2 ) 2022/06/24(金) 08:40
本日、ネットなどを参考に以下のコードを作成しました。
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim wrow As Long
Dim dicT As Object
Dim xlBook As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim key As Variant
Set dicT = CreateObject("Scripting.Dictionary")
Set ws1 = wbMoto.Worksheets("作業用シート")
maxrow1 = ws1.Cells(Rows.Count, 4).End(xlUp).Row
For wrow = 2 To maxrow1 '2行目から
key = ws1.Cells(wrow, "D").Value
dicT(key) = ws1.Cells(wrow, "E").Value
Next
Set ws2 = wbSaki.Worksheets(1)
maxrow2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
For wrow = 7 To maxrow2
key = ws2.Cells(wrow, "B").Value
If dicT.exists(key) = True Then
ws2.Cells(wrow, "D").Value = dicT(key)
End If
Next
これを実行すると転記は上手くいきました。
しかしあくまでも抽出条件は設定していません。
これを
転記先ファイルを開いた後
VBAが組み込まれているファイルの抽出条件があるシート(シート名は作業用シート)】
__A__ __B__ 1 項目1 項目1 2 TOP BBA を抽出条件としてフィルターを掛けるにはどういうコードを書いたらよいでしょうか?
(アイアン) 2022/06/24(金) 20:01
お騒がせしてすみません。
(アイアン) 2022/06/24(金) 20:30
★1
名前を挙げていただいていますが、できればご遠慮ください。
繰り返しになりますが、現状でアドバイスできることがなさそうなので過度な期待をされても困りますし、遠慮して回答を止めてしまう方もいらっしゃるかもしれません。
★2
>以下のコードを作成しました。
コードを提示される場合、Sub〜End Subまでが1つのプロシージャと呼ばれるかたまりですから、ファイルパスなどばれてまずい部分はフェイクにするにしても全てを提示されると、お互いの誤解がなくてよいと思います。
また、作成したというからには、提示されたものは"理解"できているということになりますが大丈夫なんでしょうか?
★3
>〜を抽出条件としてフィルターを掛けるには〜
こちらも繰り返しになりますが、コードは抜きにして【フィルタオプション】自体を調べてみることを強くお勧めします
【どんなデータ】を【どんな条件で】【どのように取り出したい】のかがはっきりしていれば、どのようなコードになるのか自ずと見えてくると思います。
さらに、その作業を【マクロの記録】でコード化することでもどのように記述すればよいか調べることができます。
※解決したようですが一応。
(もこな2) 2022/06/24(金) 22:59
| __A__ __B__ | 1 項目1 項目1 | 2 TOP BBA | を抽出条件としてフィルターを掛けるには その抽出条件を日本語で説明してもらえますか?
私の理解では、、 ・項目1が TOPで始まり(一致も含む) ・同時に ・項目1が BBAで始まる(一致も含む)もの という条件と解釈されます。 (同じ行に書いた条件はAND条件を解釈されます。)
そういうデータは無いので、抽出結果なし、となると思います。
フィルタオプションの条件設定については、下記を参照してください。 http://www4.synapse.ne.jp/yone/excel2010/excel2010_filter21.html (γ) 2022/06/24(金) 23:01
誤 ・【項目1】が"TOP"か"BBA" 正 ・【項目1】が"TOP"で始まり、かつ、"BBA"で始まる
※結局、該当するデータがないので抽出されないことに変わりはありませんが。
★5
実際のコードがどうなっているのかわかりませんが、「2022/06/24(金) 20:01」に提示されたコードはインデントが付いてないです。
インデントを付けるようにすると、コードの構造が把握しやすくなりご自身のデバッグ作業の効率アップに寄与すると思いますので、こだわりが無ければインデントを付けるようにするとよいと思います。
★6
最初に提示されたほうのコードを含めて気になる点について何点か。
(1)wbMoto, wbMoto1がValiant型になっています。
(2)「wbMoto」、「wbSaki」について意味合い的に逆のような気がします
この辺りは↓でも述べています。参考にしたのであれば読み返してください。
【過去ログ】 [[20210122143920]] 『データの最終行までコピー』(Help) [[20210301134135]] 『実行時エラー1004の原因』(sugar) [[20210403111842]] 『指定した値を検索し、別エクセルに転記したい』(SS) [[20210531191339]] 『別シートのマクロ実行』(すにゃ) [[20210623143216]] 『VBAのコピーについて』(健太) [[20210713155219]] 『「暗証番号付きのファイルの範囲をコピーして取込』(超初心者) [[20220614101831]] 『別ブックのワークシートのセルへの転記』(和哉)
この話をすると、何故か質問者さんが失踪するんですよね。 そうならないとよいですが・・・・
(もこな2) 2022/06/25(土) 11:55
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.