[[20220310014422]] 『IndexとMatch構文を用いたVBAでエラーが解消されax(伊藤) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『IndexとMatch構文を用いたVBAでエラーが解消されず困っています。』(伊藤)

都内の高校1年です。

情報科目の宿題で別シートを参照して、条件に合致したセル情報を転記するというプログラムをVBAで作成しなければなりません。

とりあえずテストを作成し、実行しましたがエラーが解消されず困っています。
以下詳細を記載しますので、エラーの解消のためのアドバイスを頂けると助かります。環境はWin10 OS、Excel2019になります。プログラムは初心者です。

■前提条件
・Excelに2つのシート("原本"と"転記")がある。
・"原本"に「製品型番」(P列)と「注文番号」(Z列)と「納品予定日」(AX列)の3つの情報がある。各注文レコードが何行にも連なっている。
・"転記"にも"原本"と同じ3情報:「製品型番」(O列)と「注文番号」(AD列)があるが「納品予定日」(AE列)は空欄のまま。こちらも"原本"同様、各注文レコードが何行にも連なっている。
・本VBAは"転記"にある「納品予定日」を埋めるために作成されなければならない。
・VBAの作成にあたり、"原本"の情報を参照し、"転記"の「納品予定日」を埋めるプログラムを作成する。

■作成したVBA

Sub test()

Dim ws As Object
Dim ws2 As Object
Dim i As Long

Set ws = Worksheets("原本")
Set ws2 = Worksheets("転記")
maxrow = ws2.Cells(Rows.Count, "AD").End(xlUp).Row
i = ActiveCell.Row

For i = i To maxrow

    Key = ws2.Cells(i, "O")
    Key2 = ws2.Cells(i, "AD")

    With Application
    myR = .Index(ws.Range("A1:AX"), .Match(Key & Key2, ws.Range("P:P") & ws.Range("Z:Z"), 0), 50)

    If IsError(myR) = True Then
        ws2.Cells(i, "AE") = "型番、注文番号を再度確認してください"
    Else
        ws2.Cells(i, "AE") = myR
    End If

    End With

Next i

End Sub

■VBAの補足
・VBAの実行前にアクティブセルを"転記"の「納品予定日」※セル番地上、一番最初にあるもの(セル:AE7) に合わせる。
・上記VBAの中段にあるIndex文の列番号引数にある"50"は"原本"のセルA1から数えて、「納品予定日」(AX列)が50番目に位置しているため設定。
・作成にあたっては以下のサイトを参考。
https://keiyu.xyz/2020/02/27/indexmatchvba/

■上記VBAを実行したときのエラーメッセージ
実行時エラー'1004'
アプリケーション定義またはオブジェクト定義のエラーです。

※ちなみにデバッグは中段の以下構文で黄色表示されます。
myR = .Index(ws.Range("A1:AX"), .Match(Key & Key2, ws.Range("P:P") & ws.Range("Z:Z"), 0), 50)

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


宿題を質問サイトでカンニングするような方法はお勧めできませんが何点か。

■1
変数「myR」が宣言されていません。
困ることはないでしょうが、Index関数(というより「Match関数」)がエラー値を返した場合でも、格納できるようにVariant型で宣言しておいたほうが良いでしょう。

■2
↓の狙いはなんでしょうか?

 i = ActiveCell.Row
 For i = i To maxrow

ActiveCellに依存せずとも、開始行は↓のように固定でよいのではないかと思います

 For i = 2 To maxrow

■3
↓セル範囲の指定が適切ではありません。

 ws.Range("A1:AX")

↓のように列全体にするか、AX列も【行番号】を指定してあげないとまずいと思います。

 ws.Range("A:AX")
 ws.Range("A1:AX" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
 ws.Range("A1", ws.Cells(ws.Rows.Count, "AX").End(xlUp))

■4
原本シート上で「製品型番」と「注文番号」の組み合わせがユニークだというならば、シリアル値であろう「納品予定日」はSUMIFS関数で求めることもできます。
まずはVBAはおいておいて、ワークシート上で関数を使って求めるならばどうやればよいのかを考え、それをVBAでどう表現するかという順番で考えれば、交通整理がしやすいとおもいます。

(もこな2) 2022/03/10(木) 05:11


 myR = .Index(ws.Range("A1:AX"), .Match(Key & Key2, ws.Range("P:P") & ws.Range("Z:Z"), 0), 50)

これは、Indexの中でMatch関数をつかっているので、どっちでエラーが出てるか確認しましょう

 RR = .Match(Key & Key2, ws.Range("P:P") & ws.Range("Z:Z"), 0)  ' Match関数の結果を変数RRに代入
 myR = .Index(ws.Range("A1:AX"), RR , 50)            ' 上記RR変数を使ってIndex  

このように分解してデバッグしましょう

はっきりかくと

 ws.Range("P:P") & ws.Range("Z:Z")

これがよくないです。

こっちも対応してください。
https://www.moug.net/faq/viewtopic.php?t=81319
(真田広之) 2022/03/10(木) 06:58


 高校の宿題とは思えないなぁ・・
 先生だってロクに分からないでしょう。

 VBAでは、行位置さえ分かれば、Cellsプロパティで直接アクセスできるので、Indexは余り使われない。

 Sub test()
     Dim ws As Worksheet 'Object
     Dim ws2 As Worksheet 'Object
     Dim i As Long
     Dim MaxRow As Long, MaxRow2 As Long
     Dim Key, Ary(), myR

     Set ws = Worksheets("原本")
     Set ws2 = Worksheets("転記")

     MaxRow = ws.Cells(Rows.Count, "Z").End(xlUp).Row
     MaxRow2 = ws2.Cells(Rows.Count, "AD").End(xlUp).Row

     'Matchは1行(または1列)しか対象にしないので、
     '先に原本の製品型番と注文番号を合体させて1列の配列を作る(と言う方針の場合)
     ReDim Ary(1 To MaxRow)

     For i = 2 To MaxRow
         Ary(i) = ws.Cells(i, "P") & "-" & ws.Cells(i, "Z")
     Next i

     For i = ActiveCell.Row To MaxRow2  'アクティブセルの行番号からスタートする
         Key = ws2.Cells(i, "O") & "-" & ws2.Cells(i, "AD")

         myR = Application.Match(Key, Ary, 0)

         If IsNumeric(myR) Then
             ws2.Cells(i, "AE") = ws.Cells(myR, "AX").Value
         Else
             ws2.Cells(i, "AE") = "型番、注文番号を再度確認してください"
         End If
     Next i
 End Sub

(半平太) 2022/03/10(木) 09:52


 教科「情報」が大学受験科目になるらしいですね?						
 チラッとニュースで見ましたが…いつからかは、正確にしりませんが						
 2025年より大学入試の教科が増えるのかな?						

 本題

 下記のようなマクロでは、先生に怒られるかもしれませんが						
 参考までに^^;	

 Sub Sample()

    Dim ws As Worksheet
    Dim i As Long, MaxRow As Long, myR
    Set ws = Worksheets("転記")
    MaxRow = ws.Cells(Rows.Count, "AD").End(xlUp).Row
    With ws
        .Cells(2, "AE").FormulaArray = _
        "=INDEX(原本!AX$2:AX$100,MATCH(転記!O2&転記!AD2,原本!P$2:P$100&原本!Z$2:Z$100,0))"
        .Range(.Cells(2, "AE"), .Cells(MaxRow, "AE")).FillDown
    End With
    For i = 2 To MaxRow
        myR = ws.Cells(i, "AE").Value
        If IsError(myR) = True Then
            ws.Cells(i, "AE") = "型番、注文番号を再度確認してください"
        Else
            ws.Cells(i, "AE").Value = ws.Cells(i, "AE").Value
            ws.Cells(i, "AE").NumberFormatLocal = "yyyy/m/d"
        End If
    Next

 End Sub

 ※原本の適用範囲は、適当に変更してください。					

(あみな) 2022/03/11(金) 13:42


もこな2さん、真田広之さん、半平太さん、あみなさん

丁寧なご回答ありがとうございました。

構文全体としてどう動くのかという観点が自分に不足していたことを感じました。ご指摘の終盤にある配列数式のご指摘の部分も、確かにおっしゃる通りで言語自体の体系的な知識習得がまず必要なことがわかりました。
(伊藤) 2022/03/11(金) 15:01


 (伊藤)さんへ

 先生の模範解答がわかったら、ここへUPしてくださいね。
 楽しみにしてますから... ((*p'∀'q))ワクワク

(あみな) 2022/03/11(金) 21:11


 >先生の模範解答がわかったら、

 そんなの存在しないと思いますよ。

 mougではこう言う展開です。("高校生"曰く)
      ↓
>Match,Indexの使用が指示されてはおらず、回答があってればなんでもOKということでした。
https://www.moug.net/faq/viewtopic.php?t=81319

(半平太) 2022/03/11(金) 21:52


 >そんなの存在しないと思いますよ。

 (半平太)さん、情報をありがとうございます。
  そのようですね。^^;

(あみな) 2022/03/11(金) 22:19


mougより引用

 回答 

 投稿日時: 22/03/11 14:03:11 
 投稿者: simple 

 情報Bだそうですが、本当ですか? 
 私も間違っていたのですが、 
 情報A,B,Cというのは一世代前のものでした。 
 https://ja.wikipedia.org/wiki/%E6%83%85%E5%A0%B1_(%E6%95%99%E7%A7%91) 
 現行の「情報A」、「情報B」、「情報C」の3科目構成を見直し、 
 平成25年度から「社会と情報」、「情報の科学」の2科目が設けられる。 

 なお、令和4年度からのものは、情報?Tと情報?Uでした。 

ですから高校生を騙った質問ということでしょう。
フラットに質問することを推奨します。

() 2022/03/11(金) 22:38


コメント返信:

[ 一覧(最新更新順) ]


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