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

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

ただいまの
回答率

91.36%

  • VBA

    1122questions

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

  • 検索

    63questions

    検索は、あるデータの集まりの中から 目的のデータを見つけ出すことです。

vba 行と列を指定→検索して値を転記

解決済

回答 2

投稿 2017/11/29 17:40

  • 評価
  • クリップ 0
  • VIEW 96

omotti

score 2

前提・実現したいこと

2つシートがあり、それぞれに表があります。
一つは元表、もう一つは転記先の表です。

イメージ説明
イメージ説明

転記先の表は91行目まであります。

元表のデータを、「社名」と「見出し」で合致するセルに転記をさせ、元表に社名がない行は、空欄にしたいです。
ワークシート関数ですと、INDEX関数とMATCH関数の組み合わせでクロス検索するという方法があると思いますが、それをマクロで表現したいです。

該当のソースコード

Sub 作成()

    Const KURIKOSIKIN_COL As Long = 4 '「転記先」シート「繰越税抜金額列」

    Const KENSAKU_CLM As Long = 2 '「転記先」シートB列
    Const KENSAKU_ROW As Long = 4 '「転記先」シート4行目

    Dim Sh_Tenki As Worksheet '「転記先」シート

    Dim Data_Hanni As Range 'index関数のデータ範囲

    Dim Kensaku_Hanni1 As Range  'match関数の検索する範囲①
    Dim Kensaku_Hanni2 As Range  'match関数の検索する範囲②

    Set Data_Hanni = Worksheets("元表").Range(Cells(7, 4), Cells(20, 8)) 'index関数のデータ範囲($D$7:$H$20Set Sh_Tenki = Worksheets("転記先")    
    Set Kensaku_Hanni1 = Worksheets("元表").Range(Cells(7, 3), Cells(20, 3)) '検索する範囲①($C$7:$C$20Set Kensaku_Hanni2 = Worksheets("元表").Range(Cells(6, 4), Cells(6, 8)) '検索する範囲②($D$6:$H$6)

    Worksheets("転記先").Cells(5, 4).Value = WorksheetFunction.Index(Data_Hanni, _
    WorksheetFunction.Match(Sh_Tenki.Cells(5, KENSAKU_CLM), Kensaku_Hanni1, 0), _
    WorksheetFunction.Match(Sh_Tenki.Cells(KENSAKU_ROW, 4), Kensaku_Hanni2, 0))

End Sub

試したこと

INDEX関数とMATCH関数を使って、転記先表の「D1」だけ転記させることはできました。
(その後FOR~を使って転記先表の91行目まで転記させるように書いてみましたが、うまく行かず、どう直せば良いのかも分かりませんでした)

やり方はこだわりません。
良いやり方がありましたら教えてください。
宜しくお願い致します。

補足情報(言語/FW/ツール等のバージョンなど)

より詳細な情報

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

+1

INDEX~MATCHの結果をD5セルに出力することはできていますよね。
これを「ループ処理にしてみたがうまくいかなかった」ということですが、肝心のループ処理のコードが開示されていないので、どう間違えてしまったのかがわかりません。

D列の4と、5行目の5を変数化してループさせたのであれば、やりかたとしては間違っていないと思います。

    Dim iRow As Integer
    Dim iCol As Integer
    For iRow = 5 To 91
        For iCol = 4 To 8
            Sh_Tenki.Cells(iRow, iCol).Value = WorksheetFunction.Index(Data_Hanni, _
                                                    WorksheetFunction.Match(Sh_Tenki.Cells(iRow, KENSAKU_CLM), Kensaku_Hanni1, 0), _
                                                    WorksheetFunction.Match(Sh_Tenki.Cells(KENSAKU_ROW, iCol), Kensaku_Hanni2, 0))
        Next
    Next

原因?

うまく動かなかった原因として、思い当るのはMatch関数のエラーです。

ワークシート上でもMatch関数は検索値が見つからない場合に"N/A"エラーを返したりしますが、これはVBA上でも同じです。
検索値が見つからない行を処理した時点でMatch関数がエラーとなり、そこでエラーメッセージが表示されて処理中断となってしまいます。
このためVBAでMATCH関数を利用する場合、On Errorによるエラートラップがほぼ必須となります。

    'エラーが発生しても無視して処理を継続(乱暴ですが。)
    On Error Resume Next

    Dim iRow As Integer
    Dim iCol As Integer
    For iRow = 5 To 91
        For iCol = 4 To 8
            Sh_Tenki.Cells(iRow, iCol).Value = WorksheetFunction.Index(Data_Hanni, _
                                                    WorksheetFunction.Match(Sh_Tenki.Cells(iRow, KENSAKU_CLM), Kensaku_Hanni1, 0), _
                                                    WorksheetFunction.Match(Sh_Tenki.Cells(KENSAKU_ROW, iCol), Kensaku_Hanni2, 0))
        Next
    Next

代案

今回の処理では、1セルの値を取得するたびに「MATCHする社名」「MATCHする項目名」をそれぞれ検索しています。
たしかにワークシート上の1セルでクロス検索する場合にはこれが必要ですが、VBAで行うのであればそこにとらわれる必要もありません。

①転記先シートの行をループ処理
~行ループここから~
 ② 社名の一致する行を元表シートから検索する
 ③-a 見つからなかった場合
  ⇒何もせず次の行の処理(②)へ
 ③-b 見つかった場合
  ⇒転記先シートの列をループ処理
  ~列ループここから~
  ④ 項目名の一致する列を元表シートから検索する
  ⑤-a 見つからなかった場合
   ⇒何もせず次の列の処理(④)へ
  ⑤-b 見つかった場合
   ⇒元表の行番号・列番号のセルから値を取得し、転記先シートの対象行・対象列に出力する
 ~列ループここまで~
~行ループここまで~


以上のような流れで処理すれば、同じ社名を何度も検索する必要はなくなります。

この際、検索にMATCH関数を使ったのでは、やはりアンマッチの際にエラーが発生してしまいます。
FIND関数なら見つからなかった場合にNothingが取得されるので、これを利用する方法もありますが、そもそも何度もセル参照すること自体が処理を遅くする原因になります。

そこで今回はDictionalyを利用した方法をご紹介します。

最終的には上記の処理の流れで検索するのですが、その前に「元表」シートのキーとなる情報をディクショナリに格納します。
今回は検索したいものが「社名」と「項目名」の2つありますので、ディクショナリも2つ用意します。

社名ディクショナリには元表に存在する「社名」とその「行番号」を格納します。
こうしておくことで、社名ディクショナリに対して「社名」をキーとして検索をかけると、元表シートの「行番号」を取得することができるようになります。

同様に項目名ディクショナリにも元表に存在する「項目名」とその「列番号」を格納しておきます。

あとは転記先の行・列をループして、このディクショナリから元表シートの行番号・列番号を取り出すだけです。

以下、上記を実装したサンプルコードです。一部対象範囲の動的変更なども盛り込んでみました。

Sub 作成2()
    Const KENSAKU_CLM As Long = 2 '「転記先」シートB列
    Const KENSAKU_ROW As Long = 4 '「転記先」シート4行目

    Const MOTO_KEY_CLM As Long = 3 '「元表」シートのキー列(社名列:C列)
    Const MOTO_KEY_ROW As Long = 7 '「元表」シートのキー行(項目見出し行:7行目)

    Dim Sh_Moto As Worksheet    '「元表」シート
    Dim Sh_Tenki As Worksheet   '「転記先」シート

    'Dictionaryオブジェクトの宣言
    Dim dicShamei As Object     '元表の社名行番号ディクショナリ
    Dim dicKomoku As Object     '元表の項目名列番号ディクショナリ

    Dim iRRow As Integer        '元表シートの読込行
    Dim iRCol As Integer        '元表シートの読込列

    Dim iWRow As Integer        '転記先シートの出力行
    Dim iWCol As Integer        '転記先シートの出力列

    Set Sh_Moto = Worksheets("元表")
    Set Sh_Tenki = Worksheets("転記先")

    Set dicShamei = CreateObject("Scripting.Dictionary")
    Set dicKomoku = CreateObject("Scripting.Dictionary")

    '【ディクショナリ作成】
    '元表シートから社名のディクショナリを作成
    For iRRow = 8 To Sh_Moto.Cells(8, MOTO_KEY_CLM).End(xlDown).Row
        '社名をキーとして行番号をディクショナリに保管(同じ社名が複数存在した場合、後勝ちで行番号が上書きされます)
        dicShamei(Sh_Moto.Cells(iRRow, "C").Value) = iRRow
    Next
    '元表シートから項目名のディクショナリを作成
    For iRCol = 4 To Sh_Moto.Cells(MOTO_KEY_ROW, 4).End(xlToRight).Column
        '項目名をキーとして列番号をディクショナリに保管
        dicKomoku(Sh_Moto.Cells(7, iRCol).Value) = iRCol
    Next

    '【転記処理】
    '転記先シートの社名ループ
    For iWRow = 5 To Sh_Tenki.Cells(5, KENSAKU_CLM).End(xlDown).Row
        '社名から元表の行番号を取得
        If dicShamei.Item(Sh_Tenki.Cells(iWRow, KENSAKU_CLM).Value) = "" Then
            '社名から行番号が取得できない場合は何もしない
        Else
            '元表の行番号を取得
            iRRow = dicShamei.Item(Sh_Tenki.Cells(iWRow, KENSAKU_CLM).Value)

            '転記先シートの項目ループ
            For iWCol = 4 To Sh_Moto.Cells(KENSAKU_ROW, 4).End(xlToRight).Column
                '項目名から元表の列番号を取得
                If dicKomoku.Item(Sh_Tenki.Cells(KENSAKU_ROW, iWCol).Value) = "" Then
                    '項目名から列番号が取得できない場合は何もしない
                Else
                    '元表の列番号を取得
                    iRCol = dicKomoku.Item(Sh_Tenki.Cells(KENSAKU_ROW, iWCol).Value)
                    '「元表」シートの取得行・取得列のセルの値を、「転記先」シートの出力行・出力列に出力する
                    Sh_Tenki.Cells(iWRow, iWCol).Value = Sh_Moto.Cells(iRRow, iRCol).Value
                End If
            Next iWCol
        End If
    Next iWRow

End Sub


参考になれば幸いです。

投稿 2017/11/30 17:35

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/12/04 15:00

    いつもお世話になっております。
    コードまで書いていただき本当にありがとうございます。

    元々のエクセルにコードを貼り付けさせていただいて実行したのですが、
    エラーなのか、固まってしまいました。
    元表と転記表だけのブックで実行するときちんと動きますので、
    なにが悪いのか調べてみます。

    キャンセル

  • 2017/12/05 15:40

    無事エラー解決しました。
    今は理解できないのですが、よくよく勉強します。
    大変ありがとうございました。

    キャンセル

  • 2017/12/05 18:22

    コメントを見るのが遅くなってしまいました。すみません。
    解決はされたようですが、疑問も残っているようですので何か助言でも・・と思ったのですが、ブックの状態次第では正常な動作もしているようで。

    そもそも読み書きする2つのシート以外に依存するような処理は記述していませんので、環境的な問題(メモリ不足など)なのか、ブックの問題(データ範囲が膨大とか、ブック自体が破損しているとか)なのか、ちょっといいアドバイスはできそうもありません。
    申し訳ないです。

    >今は理解できないのですが、よくよく勉強します。
    ネット検索などで得たコードを利用するのはよくあることですが、ただコピペするだけでは自分には何も残りません。
    次もまた検索してコピペしなければならなくなりますし、アレンジもできないでしょう。

    面倒でも、何をしているのか1行ずつ調べてみて、自分の知識として身に着けていってください。
    頑張ってください。

    キャンセル

  • 2017/12/06 16:13

    コメントありがとうございます。

    理由は分からないのですが、元表を一から作り直したら上手く作動しました。
    元々のシートには、質問に載せました自作のコードを登録をしていたボタンを作っていまして、
    そのボタンをなくしたら作動したので、それが原因なのかなと推測しています。

    作っていただいたコードを使うことができて安心しました。
    ありがとうございました。
    勉強頑張ります。

    キャンセル

0

正直、VBAでやるメリットが分かりません。

転記先のシートの1行目の数式を、
データ全体にコピペするくらいの手間を、
苦労してVBA化しても、小さな変化で動かなくなりますよ?

もちろん柔軟に作る事も可能ですが、
幾つもハードルがあります。

それに、もし自分がVBA作るとしても、
1行目に数式をセットしといて、
データ最終行までコピペさせます。

その方が簡単かつ調整しやすいからです。

なので、なぜVBAでやりたいのか、
その本当の目的を伝えないと
意味のある答えは返ってきにくいかと。

投稿 2017/11/29 18:39

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/11/30 14:51

    そうなんですか・・・

    転記先の表は他の部署で作り、使用している表で、私は入力したものを提出しています。
    ですので、転記先の表は勝手に数式を入れるなどの加工をせず、自動で転記できたらなと思いました。

    初心者にはハードルが高いのでしたら、他の方法も考えます。
    ありがとうございました。

    キャンセル

  • 2017/11/30 16:54

    よくある部署間での摩擦ですね。

    個人的には他部署も巻き込んで、
    「数式セットするから、
     データをコピペするだけで良くなるよ??」
    と持ちかけてルールを変えてしまいますね~

    じゃないと、延々と無駄な作業が残っていくので(汗)

    こういった事柄はよくあることで、
    「無理やり」対応する選択肢は無くはないですが、
    システム化の流れとしては本末転倒かと。

    また、他部署が関係するとなってくると、
    様々なチェック機能を盛り込んでおかないと、
    何かあった時(列が挿入、項目入れ替え etc)に、
    自分だけ気づかず、後で怒られるということも。。。泣

    まずは個人的な範囲で、
    作業効率やチェックするツールを試してみてはいかがでしょうか?

    キャンセル

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

ただいまの回答率

91.36%

関連した質問

同じタグがついた質問を見る

  • VBA

    1122questions

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

  • 検索

    63questions

    検索は、あるデータの集まりの中から 目的のデータを見つけ出すことです。