質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

1401閲覧

別ブックへのセル照合転記

jabe

総合スコア43

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2021/03/05 11:05

編集2021/03/07 01:40

前提・実現したいこと

テーマ:転記元ファイルからマクロ実行し、転記先ファイルへ照合と転記
①転記元ファイルのセルA2から最終行(セルへ入力済)の値(A2,A3,A4...)に対して、
転記先ファイルのセルA2から最終行(セルへ入力済)の値(A2,A3,A4...)を照合
②合致した場合は、転記先該当セル(A2,A3,A4...)へ上書き
③合致しない場合は、転記先最終行(セルへ入力済)の次行へ転記
④マクロ実行完了後、転記先ファイルは閉じる
条件:マクロ実行の範囲として、常にA2以降の入力済セル全行を照合

発生している問題・エラーメッセージ

・"インデックスが有効範囲にありません"というエラーが発生してしまいます。 ・別ブックへの複数ある検索値を1つずつ照合し転記するコードも記載したのですが、 正解が分からずご相談させていただきました。

該当のソースコード

VBA

1Sub 別ブックへの転記△2() 2Const TenkiMoto As String = "C:\テスト" '転記元ファイルパス 3Const TenkiSaki As String = "C:\Users\nakagami\Desktop\サンプル" '転記先ファイルパス 4Dim TM As Workbook '転記元ファイル名変数 5Dim TS As Workbook '転記先ファイル名変数 6Dim lastrowM As Long '転記元最終行数取得 7Dim lastrowS As Long '転記先最終行数取得 8Dim wsM As Worksheet '転記元ワークシート変数 9Dim wsS As Worksheet '転記先ワークシート変数 10Dim i As Long '転記元行数カウンタ 11Dim j As Long '転記先入力カウンタ 12Dim numberM As Variant '転記元検索値 13Dim resultS As Variant '転記先検索結果 14 15 Set TM = ThisWorkbook 'このマクロがあるファイルが転記元 16 Set TS = Workbooks.Open(TenkiSaki & "\転記先.xlsx") '転記先ファイル名を変数格納 17 18 Set wsM = TM.Worksheets(1) '転記元シートを変数格納 19 Set wsS = TS.Worksheets(1) '転記先シートを変数格納 20 21 lastrowM = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row '転記元シート最終行数抽出 22 lastrowS = wsS.Cells(wsS.Rows.Count, 1).End(xlUp).Row '転記先シート最終行数抽出 23 24 For i = 2 To lastrowM '転記元検索値が存在するまで繰り返す 25 numberM = wsM.Cells(i, 1).Value '転記元検索値を変数格納 26 If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then 27 lastrowS = lastrowS + 1 28 wsS.Cells(lastrowS, 1) = numberM 29 wsS.Cells(lastrowS, 2) = wsM.Cells(i, 2).Value 30 wsS.Cells(lastrowS, 3) = wsM.Cells(i, 3).Value 31 Else 'こちらから合致した場合の上書き処理をしたいと考えております。 32 33 End If 34 Next i 35 TS.Close SaveChanges:=True 36 37End Sub 38

●転記元ファイル中身
イメージ説明
●転記元ファイルパス:C:\テスト\転記元.xlsm

●転記先ファイル中身
イメージ説明
●転記先ファイルパス:C:\Users\nakagami\Desktop\サンプル\転記先.xlsx

ここにより詳細な情報を記載してください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

m.ts10806

2021/03/05 11:08 編集

エラーはどこで(どのときに)起きていますか? また、そのときデバッグモードになるかと思いますが 各変数には何が入っていますか?
meg_

2021/03/05 11:09

> ・"インデックスが有効範囲にありません"というエラーが発生してしまいます。 ”何処で”それが発生するのでしょうか?
jabe

2021/03/05 14:34

ご連絡ありがとうございます。 はい、デバッグモードになります。 エラーはC:\Users\nakagami\Desktop\サンプル\転記先.xlsxの行で発生してしまいます。変数はNothingになっています。
jinoji

2021/03/06 00:05

実現したいことの記述 と 説明画像 と コード が微妙に食い違ってます。 画像から想像すると、転記元のC列の値が転記先のC列になかったら、転記先最終行の次行に転記 その際、A列は転記元そのままではなく転記先の中での連番(最終行の値+1)を、 B,C列は転記元の値をセットする、という仕様なのかな、と思えます。 あと、フォルダパスは C:\Users\jabe\Desktop\サンプル とかがいいかもです。 エラーは、たぶんWorkbooks(xxxxx) の使い方が正しくないために起きていると思われます。 以下のいずれかのようにすれば解消すると思います。 Workbooks(1)        ・・・いま開いている1つ目のブック Workbooks("転記元.xlsm")  ・・・フルパスではNG
jabe

2021/03/06 06:44

連絡ありがとうございます。 言葉足らずで申し訳ありません。今回は連番せず番号不一致の場合のみあらたに転記と考えています。 フォルダパス気を付けます。 なるほどです。変数の勢いでフルパスを入れていました。
guest

回答1

0

ベストアンサー

これでどうでしょうか。

VBA

1 2' Set TM = Workbooks.Open(TenkiMoto & "\テスト\転記元.xlsm") '転記元ファイル名を変数格納 3 Set TM = ThisWorkbook 'このマクロがあるファイルが転記元 4 Set TS = Workbooks.Open(TenkiSaki & "\転記先.xlsx") '転記先ファイル名を変数格納 5 6 Set wsM = TM.Worksheets(1) '転記元シートを変数格納 7 Set wsS = TS.Worksheets(1) '転記先シートを変数格納 8 9 lastrowM = wsM.Cells(wsM.Rows.Count, 1).End(xlUp).Row '転記元シート最終行数抽出 10 lastrowS = wsS.Cells(wsS.Rows.Count, 1).End(xlUp).Row '転記先シート最終行数抽出 11 12 For i = 2 To lastrowM '転記元検索値が存在するまで繰り返す 13 numberM = wsM.Cells(i, 2).Value '転記元検索値を変数格納 14 If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then 15 lastrowS = lastrowS + 1 16 wsS.Cells(lastrowS, 1) = numberM 17 End If 18 Next i

投稿2021/03/05 11:16

編集2021/03/05 23:49
jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jabe

2021/03/06 06:37

ご丁寧にご回答していただきありがとうございます。 狙い通りに動作しました。 以下コードについて、教えてください。 If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then 今回のサンプルの際以下のように処理されますが、③の処理範囲がA2:(2,1)の為、②の転記セルが範囲対象外になっていると思うのですが、プログラムは問題なく動作していますので、どうい理屈になっていますでしょうか? ①転記元セル値1の場合_lastrowS=2_if判定=1_検索範囲:A2:(1,1) ②転記元セル値2の場合_lastrowS=2_if判定=0_検索範囲:A2:(1,1) ③転記元セル値3の場合_lastrowS=3_if判定=0_検索範囲:A2:(2,1)
jinoji

2021/03/06 08:24 編集

Range("A2").Resize(2, 1) は A2セルを起点にした2行×1列の範囲、 つまりRange("A2:A3")ということですので、 ②で転記するA3セルは範囲対象に含んでいます。
jinoji

2021/03/06 08:23

もっとシンプルに If WorksheetFunction.CountIf(wsS.Range("A:A"), numberM) = 0 Then でもよかったかもしれません。
jabe

2021/03/06 13:40

説明とアドバイスしていただき、ありがとうございます。 検索範囲頭を起点として範囲という事でresizeプロパティ理解する事が出来ました。 なるほど、A列すべて検索という方法もあるんですね。
jabe

2021/03/07 01:36

jinojiさん、質問からステップアップしてしまうのですが、以下相談させてください。 ・このコードで照合合致した際に、セル上書きをさせたい場合は、どのような処理を実施すればよろしいでしょうか? ※私なり、コード編集し再アップロードさせていただきましたので、お手数お掛けしますが、ご確認をお願い致します。
jinoji

2021/03/07 01:45

照合合致した際にセル上書き、というのがよく分からないのですが、 元ファイルのA2セルの値は転記先のA2セルと合致する→ 元ファイルのA2セルを転記先のA2セルに上書きする?
jinoji

2021/03/07 02:13

たとえばこういうことですか? If WorksheetFunction.CountIf(wsS.Range("A2").Resize(lastrowS - 1, 1), numberM) = 0 Then lastrowS = lastrowS + 1 wsS.Cells(lastrowS, 1) = numberM wsS.Cells(lastrowS, 2) = wsM.Cells(i, 2).Value wsS.Cells(lastrowS, 3) = wsM.Cells(i, 3).Value Else '合致した場合の上書き処理 Dim matchrow matchrow = WorksheetFunction.Match(numberM, wsS.Range("A:A"), False) wsS.Cells(matchrow, 1) = numberM wsS.Cells(matchrow, 2) = wsM.Cells(i, 2).Value wsS.Cells(matchrow, 3) = wsM.Cells(i, 3).Value End If
jabe

2021/03/07 03:33

迅速な対応ありがとうございます。 まさにその通りです。狙い通り動作しました、うれしいです。 match関数で判別するやり方勉強になりました。 使いこなせれるように頑張ります。 ワークシート関数奥が深いです。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問