VBA 読み込んだデータと他ブックを比較しランク付けにしたい

Question

比較ボタン押下後、画像1の黄色枠のところに読み込んだデータ(緑枠)と他ブック(②の部分)の比較した結果を表示させたい。
読み込んだデータに近い値を上位7位でランク付けをしたいです。

実現したいことは以下になります。
1'：「自動比較ツール.xlsm」の手順②は、絶対パスで実行させたい。
2'：比較している間は、ファイルをオープンさせない。
3'：手順②の「比較一覧表.xls」は複数シートがあり、その中から上位7位を表示させたい。
4'：ランク付けは点数で評価させたい。
例えば「自動比較ツール.xlsm」の"A Sample"が"4.563"だとする。
「比較一覧表.xls」の各シートから"A Sample"の一番近い値を選ぶが、一番近かった値を点数1点とし、次に近い値を2点とし順に評価していきたい。
この評価を他データ(B Sample～G Sample)に対しても行い、"G Sample"まで比較が完了したら、合計で一番点数が低かったのを上位7位に表示させたい。

実際の画像が以下になります。

画像1　自動比較ツール.xlsmの画面

読み込んだデータ部分(緑枠)と②の格納先にある比較一覧表のエクセルファイルを比較し、データ部分に近い値を黄色枠に上位7位まで表示させたい。

画像2　比較一覧表.xlsの画面

画像の関係上一つのシートの纏めした。
実際には、シート2は、"2_比較一覧"、シート3は、"3_比較一覧"に記載しています。
この比較一覧表のファイルから読み込んだデータに近い値を探し、上位7位にランク付けしたいです。

コードが以下になります。

Private Sub Select_Read_FilesButton_Click()
    Dim FType As String     'ファイルの種類
    Dim Prompt As String    'ダイアログのタイトル
    Dim Target As String    '任意読み込むパス
    Dim FPath As Variant    'ファイル参照パス
    Dim Pos As Long         '参照先のセル
    Dim WS As Worksheet     '対象のシート名
 
    Set WS = Worksheets("データ比較")
    
    '選択できるファイルの種類をxlsに限定
    FType = "Excelブック,*.xls"

    'ダイアログのタイトルを指定
    Prompt = "対象データファイルを選択して下さい"
    
    'ファイル参照ダイアログの表示
    FPath = Application.GetOpenFilename(FType, , Prompt)
    
    'ダイアログでキャンセルボタンが押された場合は処理を終了
    If FPath = False Then
        End
    End If

    'G5セルにファイル名をセット
    WS.Cells(5, 7).Value = FPath
    
    Pos = InStrRev(Cells(5, 7).Value, "\")
    
    ' "'"はファイル名からシート名まで括る
    Target = "'" & Left(Cells(5, 7).Value, Pos) & "[" & Mid(Cells(5, 7).Value, Pos + 1) & "]"
    
    '外部参照式にて読み込む際ファイルをオープンさせない
    Range("E8") = ExecuteExcel4Macro(Target & "読み込みデータ'!R1C2")    'Sample No.表示
    
    Range("E9") = ExecuteExcel4Macro(Target & "読み込みデータ'!R1C4")    'Test No.表示
    
    WS.Range("C10").Formula = "=" & Target & "読み込みデータ'!D4"        'A Sample表示
    WS.Range("C10").Value = WS.Range("C10").Value
    
    WS.Range("E10").Formula = "=" & Target & "読み込みデータ'!D5"        'B Sample表示
    WS.Range("E10").Value = WS.Range("E10").Value
    
    WS.Range("G10").Formula = "=" & Target & "読み込みデータ'!D6"        'C Sample表示
    WS.Range("G10").Value = WS.Range("G10").Value
    
    WS.Range("C11").Formula = "=" & Target & "読み込みデータ'!D8"        'D Sample表示
    WS.Range("C11").Value = WS.Range("C11").Value
    
    WS.Range("E11").Formula = "=" & Target & "読み込みデータ'!D10"       'E Sample表示
    WS.Range("E11").Value = WS.Range("E11").Value
    
    WS.Range("G11").Formula = "=" & Target & "読み込みデータ'!D13"       'F Sample表示
    WS.Range("G11").Value = WS.Range("G11").Value

    WS.Range("I11").Formula = "=" & Target & "読み込みデータ'!D14"       'G Sample表示
    WS.Range("I11").Value = WS.Range("I11").Value

End Sub

Private Sub HikakuButton_Click()
　'この比較ボタンにコーディングしたいがどうしたらいいか分からないです。
End Sub

よろしくお願いいたします。

Answer 1

(1) 例えば、D Sampleの点数に関しては「×2」を考慮してランク付けをしたい場合は、
セルS1に「2」を入力して、
S2：=RANK(L2,L$2:L$16,1)*S$1
:(略)
S16：=RANK(L16,L$2:L$16,1)*S$1
としてください。

(2) [データ比較]シートの黄色枠の書式を変更したくない場合は、コードの下の方を以下にしてください。

                                                        '2020/08/26 23:00 upd start
'    wshOrd.Range("A2:H8").Copy wshCmp.Range("A25")
    wshOrd.Range("A2:H8").Copy
    wshCmp.Range("A25").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
                                                        '2020/08/26 23:00 upd end

Comments

[qqkf]

回答ありがとうございました。
実現したいことができたので助かりました。
これを参考にし、VBA学習していきたいと思います。

[kitasue]

あくまでも個人の感想ですがw、重み付けをするのであれば、一番近かった値を点数１５点、次に近い値を１４点と順に評価していき、その点数に重み付けをした上で、合計で一番点数が「高い」順に表示させた方が良いように思いました。

Answer 2

自動比較ツール.xlsmにシート［順位付け］を追加し、以下の式を設定します。

i2=ABS(B2-I$1)
:(略)
o16=ABS(H16-O$1)

P2：=RANK(I2,I$2:I$16,1)
:(略)
V16：=RANK(O16,O$2:O$16,1)

W2=SUM(P2:V2)
:(略)
W16=SUM(P16:V16)

その上で、
「2'：比較している間は、ファイルをオープンさせない。」
は実装できませんでしたが、以下のコードでいかがでしょうか。

    Dim wbk As Workbook
    Dim i As Long
    Dim wshCmp As Worksheet
    Dim wshOrd As Worksheet
    
    Set wshCmp = Worksheets("データ比較")
    Set wshOrd = Worksheets("順位付け")
    
    Set wbk = Workbooks.Open(wshCmp.Range("C15").Value, ReadOnly:=True)
    For i = 1 To 3
        wbk.Worksheets(i & "_比較一覧").Range("A4:H8").Copy wshOrd.Range("A" & i * 5 - 3)
    Next i
    wbk.Close SaveChanges:=False: Set wbk = Nothing
    
    wshOrd.Range("i1").Value = wshCmp.Range("C10")
    wshOrd.Range("J1").Value = wshCmp.Range("E10")
    wshOrd.Range("K1").Value = wshCmp.Range("G10")
    wshOrd.Range("L1").Value = wshCmp.Range("C11")
    wshOrd.Range("M1").Value = wshCmp.Range("E11")
    wshOrd.Range("N1").Value = wshCmp.Range("G11")
    wshOrd.Range("o1").Value = wshCmp.Range("i11")
    
    With wshOrd.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("W2:W16")
        .SetRange Range("A2:W16")
        .Apply
    End With
    
    wshOrd.Range("A2:H8").Copy wshCmp.Range("A25")
    
    Set wshOrd = Nothing
    Set wshCmp = Nothing

Comments

[qqkf]

コーディングありがとうございました。
［順位付け］シートで比較一覧のデータを全部見れるのは大変助かりました。
質問ですが、比較後の罫線は取り除くことは可能でしょうか。
ここは手動で加工でしょうか。
また、対象の項目対して重みを付ける場合はどこをコーディングしたらよいでしょうか。
例えば、D Sampleは×2にしてランク付けをしたい。

[kitasue]

(1) 「比較後の罫線」とは、具体的にどのシートのどの部分の罫線でしょうか。
(2) 「×2」というのは、具体的にどの数字に「×2」するのでしょうか。

[qqkf]

(1)[データ比較]シートのランクした結果のNo.11とNo.12の間に罫線の部分です
「比較一覧表.xls」で使用したセルをそのまま貼り付けてためでしょうか。

(2)点数を付けて評価してますが、この点数に対して重みを付けたいです。
例えば、D Sampleの点数に関しては「×2」を考慮してランク付けをしたい。