前提・実現したいこと
毎回、初歩的な内容で恐れ入ります。
指定した年月の列に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を""で囲みましたが、結果は変わらず何も反映されませんでした。
すみません。ぱっと見ていまいちわからなかったのですが、これはもしかして
Do While Cells(k, r).Value <> ""~ でkeyを決定
→ Vlookupでkeyを検索した結果をretに格納
→ If Cells(1, r).Value = nengetsu Then~ で該当のセルにretの値を入力
という流れで処理を行いたい、ということでよろしいのでしょうか。
質問とは直接関係なくて申し訳ありません。
前回の質問を見た時にも思ったのですが、
On Error Resume Nextのなかで処理を進めているのがモヤモヤします。
エラーはあくまでもエラーなので。。。
Usirow様 返信遅くなりました。分かりにくくて恐縮です。はい。ご認識通りです。nengetsuが一致したらその下の行へretを入力していきたいです。
yo_u様 返信遅くなりました。コメント恐れ入ります。keyに該当するものが無かったとしても進むように、On Error Resume Nextを使用したのですが、きっと使い方が間違ってますね。
回答3件
あなたの回答
tips
プレビュー