VlookUPを1行ずつ反映させることができません。

前提・実現したいこと

毎回、初歩的な内容で恐れ入ります。
指定した年月の列にVlookUPを1行ずつ反映していきたいです。

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

指定した年月の列に、うまくVlookUPを1行ずつ反映させることができません。
指定した年月の列に何も反映されず、エラーも出ない状況です。

該当のソースコード

Sub test31_0125_0203()

    '①InputBoxで年月入力
    Dim ws07 As Worksheet, ws08 As Worksheet
    Dim nengetsu As Strin
    
    Set ws07 = worksheets("月次")
    Set ws08 = worksheets("月次コスト")
    
    nengetsu = Application.InputBox("年月を入力してください", Type:=2)
    
    
    '②指定月で「月次コスト」のセルを指定
    
    Dim i As Long, j As Long
    
    '元データの最終行を取得
    i = ws08.Cells(Rows.Count, 1).End(xlUp).Row
    '元データの最終列を取得
    j = ws08.Cells(1, Columns.Count).End(xlToLeft).Column

    
    '③「月次コスト」を項目毎に合計値を集計
    Dim pc As PivotCache
    Dim pt As PivotTable
    
    'ピボットテーブルに使うデータを設定                                
    Set pc = ActiveWorkbook.PivotCaches.Create( _
                                SourceType:=xlDatabase, _
                                SourceData:=ws08.Range(ws08.Cells(1, 1), ws08.Cells(i, j)))
    
    Dim shNo As String
    
    shNo = Format(Now, "yyyymmdd-hhmmss")
    
    Debug.Print shNo
    
    'ピボットテーブル作成用シート追加
    worksheets.Add(after:=worksheets(worksheets.Count)).Name = shNo
    
    
    ' ピボットテーブルを作成する
    Set pt = pc.CreatePivotTable( _
                                TableDestination:=worksheets(shNo).Range("B2"), _
                                TableName:="ピボットテーブル1")
    
    ' ピボットテーブルの詳細を設定する
    With pt
    
        
        ' (b)行ラベルに設定するデータ
        .PivotFields("項目").Orientation = xlRowField
        .PivotFields("項目").AutoGroup
        .PivotFields(nengetsu).Orientation = xlDataField 'nengetsuを""で囲むとエラーになる。nengetsuはString、Type:=2
    
    End With
    
    '④「月次」へ「月次コスト」の集計値を転記
    
    Dim row2 As Long, column2 As Long
    Dim ws09 As Worksheet
    
    Set ws09 = worksheets(shNo)
    
    'ピボットテーブルで集計したデータを選択
    '最終行を取得
    row2 = ws09.Cells(Rows.Count, 1).End(xlUp).Row
    '最終列を取得
    column2 = ws09.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Dim tbl As Range
    Set tbl = ws09.Range(Columns(2), Columns(3))
    
    ws07.Activate
    Dim key As String, k As Long
    Dim ret As String
    

    Dim s As Long
    s = ws07.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim r As Long
    For r = 2 To s

　　’ここのnengetsuが指定したところで止まらず、rの数値が進んでしまいます。
        If Cells(1, r).Value = nengetsu Then
        Cells(2, r).Value = ret
        End If
    Next
    
    ' エラーが発生しても無視して処理を継続させる。VLookUPで検索するデータにkeyが無くても続くる
    On Error Resume Next
    ret = WorksheetFunction.VLookup(key, tbl, 2, False)
    
    k = 2
    Do While Cells(k, r).Value <> ""
    key = Cells(k, r).Value
    
    k = k + 1
    Loop

End Sub

他に試したこと

    If Cells(1, r).Value = "nengetsu" Then

nengetsuを""で囲みましたが、結果は変わらず何も反映されませんでした。

Usirow

2021/02/03 23:50 編集

すみません。ぱっと見ていまいちわからなかったのですが、これはもしかして Do While Cells(k, r).Value <> ""~ でkeyを決定 → Vlookupでkeyを検索した結果をretに格納 → If Cells(1, r).Value = nengetsu Then~ で該当のセルにretの値を入力という流れで処理を行いたい、ということでよろしいのでしょうか。

yo_u

2021/02/05 06:07

質問とは直接関係なくて申し訳ありません。前回の質問を見た時にも思ったのですが、 On Error Resume Nextのなかで処理を進めているのがモヤモヤします。エラーはあくまでもエラーなので。。。

shu_shu

2021/02/06 12:02

Usirow様　返信遅くなりました。分かりにくくて恐縮です。はい。ご認識通りです。nengetsuが一致したらその下の行へretを入力していきたいです。 yo_u様　返信遅くなりました。コメント恐れ入ります。keyに該当するものが無かったとしても進むように、On Error Resume Nextを使用したのですが、きっと使い方が間違ってますね。

行動規範の内容に同意します

回答3件

ベストアンサー

もう自己解決しているかもしれませんが、最初に首を突っ込んだ責任として修正すべきと思われるポイントをあげておきます。ご質問やツッコミがあればどうぞ。
回答が遅れた上にこのような形になってしまうことは先に謝罪させていただきます。

処理の順番の見直し

わたしがコメントで確認したとおりであるならば、

'エラーへの対応などは省いています
Do While Cells(k, r).Value <> ""

    key = Cells(k, r).Value
    ret = WorksheetFunction.VLookup(key, tbl, 2, False)

    For r = 2 To s

        If Cells(1, r).Value = nengetsu Then
             Cells(2, r).Value = ret
        End If

    Next

    k = k + 1
Loop

おおよそこのような流れで処理が行われるはずですが、現状それが真逆に書かれています。そのせいで、If判定に成功してもセルに書き込むretが空です。VlookUpに使うKeyも中身が入っていませんね。
いろいろと悩んでいるものと思いますが、行いたい処理の流れを箇条書きで書き起こすなどして、丁寧に見直してみてください。

InputBoxを数値型にしてみる

InputBoxメソッド
こちらのリンクにあるように、InputBoxのType:=2は文字列型です。
以前の質問を見るに数値の比較を行っているようなので、ここを数値型に変えればうまくいきそうな気がします。そのとき、nengetsuをLongやIntegerなどの数値型にするのを忘れないでください。
rの値が上手く動いていないとも仰っていたようですが、その場合はシートを見ないとなんとも言えません。

Do Whileにrを用いない（理由があればその限りでない

rはret代入の際のForループで使われており、Do Whileの中でも変化していません。
ret代入のループの動きによっては意図しないところを参照することになります。固定の値であるならば変数は使わないか、専用の変数を用意してください。
Forループの値を使いたいのであればその限りではないです。

On Error Resume Nextをそのままにしない

VlookUpのエラーを捕まえるのはちょっと面倒だった気がするので、エラーをとりあえず無視して、あとで判定すること自体は全くのナシではないとは思います。
ただし、VlookUpを通過したらOn Error Go to 0でエラー無視を解除しておかないと別の問題を誘発します。
特に今回のようにデバッグする場合は、Resume Next自体をコメントアウトしておかないと、見つかるエラーも見つからなくなってしまいます。

投稿2021/02/09 04:46

Usirow

総合スコア364

shu_shu

2021/02/09 10:50 編集

Usirow様ご丁寧な解説、誠にありがとうございます。まず処理の順番について今後箇条書きにして見直します。頂いたコードに修正しました。その上で、 ●Do Whileにrを用いないこのコメントは、Do Whileの中でさらにFor Nextにrがあるため、Do Whileのループで戻ってきた際にまた、rが進むこととなり、エラーとなる。ご指摘はこのように理解しました。頂いたコードをもとにエラーがでないように考えてみます。 ●On Error Resume Nextをそのままにしない　お作法が理解できました。VlookUpを通過したら「On Error Go to 0」で解除します。 ●InputBoxを数値型にした場合、なぜか下記でエラーがでてしまいます。 .PivotFields(nengetsu).Orientation = xlDataField 実行時エラー1004 "ピボットテーブルクラスのPivotFieldsプロパティを取得できません"

Usirow

2021/02/10 03:47

・コードの修正わたしが出したものは、あくまで「話を聞く限り多分こうなるんじゃないかな」という例示レベルであって、そのまま使えるものではないです。実際の処理の流れをよく確認してください。・Do Whileにr～ Forループに入った段階でrの値は設定しなおされるので、仰るようなエラーは出ないと思いますが、別のループで変数を使いまわすと、意図しない動作をする可能性は高くなります。 Forループで決定したrをDo Whileの判定式にも使いたい、などの明確な意図があるなら、この指摘はわたしの早とちりになりますね。・InputBoxの型 nengetsuはピボットテーブルでも使っているんですね。でしたら、nengetsuの中身を別の数値型の変数に格納して、Ifの判定に使った場合はどうなりますか？

shu_shu

2021/02/11 11:48 編集

Usirow様何度もやり取り本当に恐れ入ります。おかげ様で現状ではエラーが出ないようになりました。図々しいですが下記についてもし何かコメント頂ければ嬉しいです。長文ですみません。・Do Whileにr～についていえいえ。ありがとうございます。処理の流れを見直し下記のコードとしてみたところ「End Ifに対応するIfブロックがありません。」のエラーが出ました。 For r = 2 To s If Cells(1, r).Value = nengetsu Then k = 2 Do While Cells(k, 1).Value <> "" key = Cells(k, 1).Value ret = WorksheetFunction.VLookup(key, tbl, 2, False) Cells(k, r).Value = ret k = k + 1 End If Loop これは、調べたところ上記のIfの場合、1行なのでEnd　Ifが不要とわかりました。なのでEnd　Ifを削除したところ今度「If1ブロックに対応するEnd　Ifがありません」と出ました。これも調べたところ、For~Loopの中で、逆にEnd　Ifが無い為のエラーということでした。ここで完全に行き詰まりました。こういう場合の一般的な対処法はありますでしょうか。もし簡単にお分かりでしたらコメント頂ければ助かります。特になければ大丈夫です。今後やりながら自己解決します。上記で行き詰ったので下記のようにIfを使わないようにコードを変えてみました。 r = Rows(1).Find(nengetsu).Column Debug.Print r On Error Resume Next k = 2 Do While Cells(k, 1).Value <> "" key = Cells(k, 1).Value Cells(k, r).Value = WorksheetFunction.VLookup(key, tbl, 2, False) k = k + 1 Loop On Error GoTo 0 としてみました。これでとりあえずはエラーが出ないようになりました。「On Error Resume Next」を使用してしまっていますが、これはVlookUpでkey検索してkeyがなかった場合でもエラーとならずにとりあえず進むように入れてます。以前頂いたコメント（他の方からも）で「On Error GoTo 0」を加えました。・InputBoxの型についてすみません。まだ追いついていません。下記で心掛けること、他に教室に通う必要性や仕事の業務に取り入れるべきなどコメント頂ければ有難いです。私の今のレベルから抜け出るには、まずは質より量でトレーニングする時間を確保し日々VBAに関してトライ＆エラーを繰り返すしかないかなと考えております。私の主な業務ではないため、どうしてもプライベートの時間で合間を見てコードを作るような状況です。

Usirow

2021/02/12 03:54

・If～のエラー Do ~ LoopのなかにEnd Ifがいるせいです。DoループとIf文を入れ子構造にしたとき、Doループ外側のIfをループ内側でEnd Ifすることはできません。If ~ Do ~ Loop ~ End Ifとなるようにしてください。このあたりは、二重ループや二重Ifを想像してもらえれば、現在のコードが何故おかしいのかわかりやすいかと思います。・Resume Next Resume Nextでもいいと回答しましたが、その前にエラーが出ない書き方を考えるべきだったと反省しています。正道としては、CountIfなどで「検索範囲にkeyが存在している」≒「VlookUpがエラーにならない」ことを確認してから処理することで、エラーを発生させずにVlookUpを使うことができます。 Resume Nextを使う場合は、その適用範囲を極力小さくしてください。VlookUp一行だけをResume Nextと GoTo 0とで挟むくらいでもいいと思います。学習については、わたしも業務の片手間に書いているだけなので回答らしい回答ができません。ただ、VBAはネット上の情報が充実している方なので、検索する力があるだけでだいぶ変わると思います。

shu_shu

2021/02/12 12:53

Usirow様やりとりが多くなってしまいすみません。手短に。業務の片手間に書かれているんですね。驚きました。てっきり本業の方だと思ってました。とりあえずエラーが出なくなりましたので今回はココで解決としたいかと。 IfのエラーとCountIfなどの対応は引き続き考えてみます。今後の学習については、考える、検索する、最後困ったらココで聞くでやってみます。お忙しい所ありがとうございました。

行動規範の内容に同意します

引用テキスト’ここのnengetsuが指定したところで止まらず、rの数値が進んでしまいます。

変数retを初期化だけして値を入れていませんが、VBAの仕様として変数宣言時に初期値が入ります。
string型であれば長さ0文字列の""が入っています。
そのため、if文で中に入った後は""を代入しているだけです。
その後にretの値でVlookupを設定していますが既に代入したものには反映されません。
先に設定しておく必要があります。

エラーが発生しても無視して処理を継続させる。VLookUPで検索するデータにkeyが無くても続くる

あまり関係ありませんがisNull関数やisEmpty関数、文字列の長さ0（""）指定などデータが空でもその種類を正確に判定できるのでOn Error Resume Nextはやめた方がいいと思います。

追記
その後のDoWhileで変数rの値を使っていますのでexit forで抜ければ再利用はできますが、if文内で別の変数にrの数値を渡してもいいと思います。
今のところif文で行っている操作は空のデータを入れているだけです。

投稿2021/02/05 06:47

編集2021/02/05 06:59

退会済みユーザー

総合スコア0

shu_shu

2021/02/06 12:07

返信遅くなりました。コメントありがとうございます。頂いた内容、当方の理解に時間がかかるため良く考えてみます。On Error Resume Nexにつきましては、別でも記入しましたが、使い方が間違ってますね。失礼いたしました。

行動規範の内容に同意します

VBA
1For r = 2 To s
2
3　　’ここのnengetsuが指定したところで止まらず、rの数値が進んでしまいます。
4        If Cells(1, r).Value = nengetsu Then
5        Cells(2, r).Value = ret
6        End If
7    Next

まず「rの数値が進んでしまいます。」ここを問題としているのなら、
これ、ifがどうであろうが r は s まで抜けないですよね？
exit forが必要なんじゃないでしょうか。

あと頭の「nengetsu」の宣言も”strin”ですね。

投稿2021/02/05 05:42

yo_u

総合スコア95