前提・実現したいこと
毎回初歩的な内容で恐れ入ります。
今回も初歩的な内容だと思いますが、上手くお伝えできずわかりにくいもしれません。
Ifで一致した値の時、VLookupで別シートから値を転記したいのですが、
指定した変数(nengetsu)がうまく検索されません。
漠然としていてコメントしずらいかもしれませんが、
どのような不具合の可能性があるかご教示頂けそうでしょうか。
発生している問題・エラーメッセージ
Activeシート(ws07)の1行目には「202101,202102」などの数値が入ってます。 nengetsuに「202101」などの数値を入力します。 「202101」を指定した場合は、Activeシート(ws07)「202101」の列に VLookupで別シートから値を転記されるのですが、「202102」や「202103」を指定した場合 エラーも出ず、何も処理されません。
該当のソースコード
Sub test31_0125_0202() '①InputBoxで年月入力 Dim ws07 As Worksheet, ws08 As Worksheet Dim nengetsu As String '形式を日付にすると年月入力した数値(値)と一致しなくなる 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 ' (a)列ラベルに設定するデータ '.PivotFields(" ").Orientation = xlColumnField ' (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(ws09.Cells(2, 2), ws09.Cells(i, j)) Set tbl = ws09.Range(Columns(2), Columns(3)) ws07.Activate Dim key As String, k As Long k = 2 Do While Cells(k, 1).Value <> "" key = Cells(k, 1).Value On Error Resume Next Dim ret As String ret = WorksheetFunction.VLookup(key, tbl, 2, False) Dim r As Long r = 2 ’ここのIfがうまく動きません。 If Cells(1, r).Value = nengetsu Then Cells(k, r).Value = ret End If k = k + 1 r = r + 1 Loop '⑤③で作成したPivot用のシートを削除 Application.DisplayAlerts = False worksheets(shNo).Delete Application.DisplayAlerts = True End Sub
試したこと
If Cells(1, r).Value = "nengetsu" Then
""を入力しない場合と結果変わらず、エラーも出ず、何も処理されません。
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2021/02/02 13:06
2021/02/02 13:23