結合セルの値を検索対象にして該当セルの値を入力したい。

Question

前提

画像のような案件管理表とそのコストを集計するファイルがあります。

実現したいこと

利益管理ファイルの「案件名」と「担当者名」を検索値として使用し、
案件管理表ファイルの「案件名」と「担当者名」が合致するデータの「人件費」を利益管理ファイルの「対応コスト」に転記したいです。

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

現状のコードだと、案件名に関わらず、該当する担当者名の人件費が対応コストに転記されてしまっています。
また、担当者名が複数いた場合、案件管理表の列が後に記載されている担当者名のデータのみが取得されてしまっています。

該当のソースコード

Sub rieki1_Clic()
'変数定義
Dim i As Integer '行の番号
Dim j As Integer '列の番号
Dim k As Integer '担当者名の列指定
Dim x As Long '案件管理表の行番号
Dim y As Long '案件管理表の列番号
Dim TargetBook As String '案件管理表指定
Dim RiekiBook As String '案件管理表指定
Dim RiekiSheet As String '案件管理表指定
TargetBook = "案件管理表.xlsm"
RiekiBook = "利益管理.xlsm"
RiekiSheet = "Sheet2"

For x = 2 To 250

'行の指定
For i = 8 To 74
'列の指定
For j = 6 To 15 
For k = 6 To 16 Step 2 '利益管理ファイルの担当者名列の指定
'利益管理ファイルの案件名が空欄でない
If Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, 2).Value <> 0 
'利益管理ファイルの対応コストの指定
And j Mod 2 = 1 
'利益管理ファイルの案件名と案件管理ファイルの案件名が一致する
And Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, 2).Value = Workbooks(TargetBook).Worksheets("Sheet1").Cells(10, x).MergeArea(1,1).Value 
'利益管理ファイルの担当者名と案件管理ファイルの担当者名が一致する
And Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, k).Value = Workbooks(TargetBook).Worksheets("Sheet1").Cells(2, x).MergeArea(1,1).Value Then
'利益管理ファイルの担当コストに案件管理表の人件費を転記
Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, j).Value = Workbooks(TargetBook).Worksheets("Sheet1").Cells(16,x).MergeArea(1,1).Value
Else
End if
Next k
Next j
Next i
Next x
End Sub

Comments

[tatsu99]

提示されたソースをコピーしてこちらで実行するとコンパイルエラーになります。
実際に動作させたソースを提示していただけませんでしょうか。
（コンパイルエラーがとれないということでしたら、そのように質問をし直してください）

[youyou40]

コンパイルエラーはどの行にエラーが発生していると出ていますか？
IF文の改行は見やすくするために入れているので、Andの前に改行を削除して試していただけますでしょうか。

[tatsu99]

コピペして、そのまま実行すると下記行でエラーになります。
If Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, 2).Value <> 0
見やすくするために、意図的に改行しているのですね。了解しました。

[tatsu99]

不明点です。
１．案件管理表のD列、E列の案件名は、見出しのように見えますが、実際の案件名が設定されますか。
もし、実際の案件名が設定されるなら、xの開始は2ではなく、5になります。
もし、実際の案件名が設定されないなら、xの開始は2ではなく、3になります。

２．利益管理ファイルの担当者の検索は、
For j = 6 To 15　の行が余分と思われますがいかがでしょうか。
For k = 6 To 16 Step 2　の行と重複しています。

[youyou40]

1. わかりづらくて申し訳ございません。
　D・E列は見出しとなります。

2. kは担当者名の列を指定
　jは担当者と対応コスト全体を指定しており、if文で対応コストのみを指定するようにしています。
　

Answer 1

修正しました。多少見やすくするために、変数を追加しました。

Sub rieki1_Clic()
'変数定義
    Dim i As Integer    '行の番号
    Dim j As Integer    '列の番号
    Dim k As Integer    '担当者名の列指定
    Dim x As Long    '案件管理表の行番号
    Dim y As Long    '案件管理表の列番号
    Dim TargetBook As String    '案件管理表指定
    Dim RiekiBook As String    '案件管理表指定
    Dim RiekiSheet As String    '案件管理表指定
    Dim anken As String    '案件名(利益管理ファイル)
    Dim tanto As String    '担当者(利益管理ファイル)
    Dim anken2 As String    '案件名(案件管理表)
    Dim tanto2 As String    '担当者(案件管理表)
    TargetBook = "案件管理表.xlsm"
    RiekiBook = "利益管理.xlsm"
    RiekiSheet = "Sheet2"

    For x = 3 To 250

        '行の指定
        For i = 8 To 74
            anken = Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, 2).Value
            For k = 6 To 16 Step 2    '利益管理ファイルの担当者名列の指定
                tanto = Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, k).Value
                '利益管理ファイルの案件名が空欄でないかつ 利益管理ファイルの担当者が空欄でない
                If anken <> "" And tanto <> "" Then
                    anken2 = Workbooks(TargetBook).Worksheets("Sheet1").Cells(10, x).MergeArea(1, 1).Value
                    tanto2 = Workbooks(TargetBook).Worksheets("Sheet1").Cells(2, x).MergeArea(1, 1).Value
                    '利益管理ファイルの担当者名と案件管理ファイルの担当者名が一致する
                    If tanto = tanto2 And anken = anken2 Then
                        '利益管理ファイルの担当コストに案件管理表の人件費を転記
                        Workbooks(RiekiBook).Worksheets(RiekiSheet).Cells(i, k + 1).Value = Workbooks(TargetBook).Worksheets("Sheet1").Cells(16, x).MergeArea(1, 1).Value
                    End If
                End If
            Next k
        Next i
    Next x
End Sub

Comments

[youyou40]

回答ありがとうございます！無事やりたいことを実現できました。