VBA 識別子を用いて別ブックから値を転記させたい

Question

vbaに関する質問です。

このような一覧表があります。

・設定値.xlsm

この表に以下のパラメータ表を用いて、同じタイトル番号、同じ識別子の場所に転記させていきたいです。

・パラメータ.xlsm

以下が作りたい形となります。

イメージとしては

1.設定値.xlsmのN9セル以下に「パラメータ参照」という記載があったら
2.そのセルと同じ行のC列の識別子「設定値-1-~」と、B2セルのParamater_⓵という値から、⓵をキー　ワードにする
3.パラメータ.xlsmから2で見つけたキーワードを検索
4.該当する箇所の値を設定値.xlsmに転記する
5.以下繰り返しで設定値.xlsmのN列を値の入っている最終セルまで転記させます。

自分なりにコードを書いてみたのですが、どうもうまくいかず困っております。

何とか本日、明日中には解決させたいと考えています。
よろしくお願いいたします。

Dim v 
Dim Num
Dim rngSearch 
Dim Range1
Dim Range2
Dim Param1
Dim Param2
                
BookName1 = "設定値.xlsm"
Set Param1 = Application.Workbooks(BookName1)

BookName2 = "パラメータ.xlsm"
Set Param2 = Application.Workbooks(BookName2)
                
For v = 9 To Param1.Worksheets("設定値").Cells(9, 3).End(xlDown).Row
   Set Range1 = ActiveWorkbook.Worksheets("設定値").Cells(v, 14).Find("パラメータ参照")
   Num = Range1.Offset(0, -11).Value
   
'値が"パラメータ参照"の場合
   If Not (Num Is Nothing) Then
      Set Range2 = Param2.Worksheets("パラメータ").Column("A").Find("設定値" & "-" Num)
      Set rngSearch = Range1.Find(What:="パラメータ参照", LookAt:=xlWhole)
                        
'値が"パラメータ参照"ではない場合
   Else
      GoTo CONTINUE

   End If

CONTINUE:
   Next v

Comments

[meg_]

「自分なりにコードを書いてみたのですが、どうもうまくいかず」とのことですが、具体的には何が出来ていて何が出来ていないのでしょうか？

[aki0430]

If Not (Num Is Nothing) Then

この部分で オブジェクトが必要です とエラーを吐いて止まってしまい、何もできていない状態になってしまいます。

[meg_]

そのことを質問に書くべきですよ。

[aki0430]

申し訳ございませんでした。

Answer 1

Findごとに入れたほうが良いかな。If Not (xxxxxxxxx Is Nothing) Then

Dim v As Long
Dim Num As String
Dim Range1 As Range
Dim Param1 As Worksheet
Dim Param2 As Worksheet
Dim PlRangeCol As Range
Dim PlRangeRow As Range

BookName1 = "設定値.xlsm"
Set Param1 = Application.Workbooks(BookName1).Worksheets("設定値")

BookName2 = "パラメータ.xlsx" 'パラメータ.xlsm"
Set Param2 = Application.Workbooks(BookName2).Worksheets("パラメータ")

For v = 9 To Param1.Cells(9, 3).End(xlDown).Row
  Set Range1 = Param1.Cells(v, 14).Find("パラメータ参照")
  If Not (Range1 Is Nothing) Then
'値が"パラメータ参照"の場合
    'Columun
    Num = Right(Param1.Cells(2, 2).Value, 1)
    Set PlRangeCol = Param2.Rows(2).Find(Num)
    If Not (PlRangeCol Is Nothing) Then
    'Row
      Num = Range1.Offset(0, -11).Value
      Set PlRangeRow = Param2.Columns("A").Find(Num)
      If Not (PlRangeRow Is Nothing) Then
        Param1.Cells(v, 14).Value = Param2.Cells(PlRangeRow.Row, PlRangeCol.Column).Value
      End If
    End If
  End If
Next v

Comments

[aki0430]

ありがとうございました！
書いていただいたコードを試した結果、望むものができました。

Answer 2

If Not (Num Is Nothing) ThenをIf Not Range1 Is Nothing Thenに変えたらどうでしょうか？

---

【追記】
Set Range2 = Param2.Worksheets("パラメータ").Column("A").Find("設定値" & "-" Num)をSet Range2 = Param2.Worksheets("パラメータ").Column("A").Find("設定値" & "-" & Num)に変えたらどうでしょうか？　※&を追加

Comments

[aki0430]

ありがとうございます。
教えていただいた表記に変更したところ、先のエラーはなくなりましたが、

Set Range2 = Param2.Worksheets("パラメータ").Column("A").Find("設定値" & "-" Num)

の箇所で オブジェクトは、このプロパティまたはメソッドをサポートしていません。のエラーが出てしまいます。

回避方法をご教授願えないでしょうか？