質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

1551閲覧

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

qqkf

総合スコア10

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

1クリップ

投稿2020/08/25 13:03

編集2020/08/25 15:57

比較ボタン押下後、画像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位にランク付けしたいです。

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

VBA

1Private Sub Select_Read_FilesButton_Click() 2 Dim FType As String 'ファイルの種類 3 Dim Prompt As String 'ダイアログのタイトル 4 Dim Target As String '任意読み込むパス 5 Dim FPath As Variant 'ファイル参照パス 6 Dim Pos As Long '参照先のセル 7 Dim WS As Worksheet '対象のシート名 8 9 Set WS = Worksheets("データ比較") 10 11 '選択できるファイルの種類をxlsに限定 12 FType = "Excelブック,*.xls" 13 14 'ダイアログのタイトルを指定 15 Prompt = "対象データファイルを選択して下さい" 16 17 'ファイル参照ダイアログの表示 18 FPath = Application.GetOpenFilename(FType, , Prompt) 19 20 'ダイアログでキャンセルボタンが押された場合は処理を終了 21 If FPath = False Then 22 End 23 End If 24 25 'G5セルにファイル名をセット 26 WS.Cells(5, 7).Value = FPath 27 28 Pos = InStrRev(Cells(5, 7).Value, "\") 29 30 ' "'"はファイル名からシート名まで括る 31 Target = "'" & Left(Cells(5, 7).Value, Pos) & "[" & Mid(Cells(5, 7).Value, Pos + 1) & "]" 32 33 '外部参照式にて読み込む際ファイルをオープンさせない 34 Range("E8") = ExecuteExcel4Macro(Target & "読み込みデータ'!R1C2") 'Sample No.表示 35 36 Range("E9") = ExecuteExcel4Macro(Target & "読み込みデータ'!R1C4") 'Test No.表示 37 38 WS.Range("C10").Formula = "=" & Target & "読み込みデータ'!D4" 'A Sample表示 39 WS.Range("C10").Value = WS.Range("C10").Value 40 41 WS.Range("E10").Formula = "=" & Target & "読み込みデータ'!D5" 'B Sample表示 42 WS.Range("E10").Value = WS.Range("E10").Value 43 44 WS.Range("G10").Formula = "=" & Target & "読み込みデータ'!D6" 'C Sample表示 45 WS.Range("G10").Value = WS.Range("G10").Value 46 47 WS.Range("C11").Formula = "=" & Target & "読み込みデータ'!D8" 'D Sample表示 48 WS.Range("C11").Value = WS.Range("C11").Value 49 50 WS.Range("E11").Formula = "=" & Target & "読み込みデータ'!D10" 'E Sample表示 51 WS.Range("E11").Value = WS.Range("E11").Value 52 53 WS.Range("G11").Formula = "=" & Target & "読み込みデータ'!D13" 'F Sample表示 54 WS.Range("G11").Value = WS.Range("G11").Value 55 56 WS.Range("I11").Formula = "=" & Target & "読み込みデータ'!D14" 'G Sample表示 57 WS.Range("I11").Value = WS.Range("I11").Value 58 59End Sub 60 61Private Sub HikakuButton_Click() 62 'この比較ボタンにコーディングしたいがどうしたらいいか分からないです。 63End Sub

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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

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

VBA

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

投稿2020/08/26 14:08

編集2020/08/27 19:32
kitasue

総合スコア314

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

qqkf

2020/08/26 15:22

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

2020/08/26 23:09

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

0

ベストアンサー

自動比較ツール.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':比較している間は、ファイルをオープンさせない。」
は実装できませんでしたが、以下のコードでいかがでしょうか。

VBA

1 Dim wbk As Workbook 2 Dim i As Long 3 Dim wshCmp As Worksheet 4 Dim wshOrd As Worksheet 5 6 Set wshCmp = Worksheets("データ比較") 7 Set wshOrd = Worksheets("順位付け") 8 9 Set wbk = Workbooks.Open(wshCmp.Range("C15").Value, ReadOnly:=True) 10 For i = 1 To 3 11 wbk.Worksheets(i & "_比較一覧").Range("A4:H8").Copy wshOrd.Range("A" & i * 5 - 3) 12 Next i 13 wbk.Close SaveChanges:=False: Set wbk = Nothing 14 15 wshOrd.Range("i1").Value = wshCmp.Range("C10") 16 wshOrd.Range("J1").Value = wshCmp.Range("E10") 17 wshOrd.Range("K1").Value = wshCmp.Range("G10") 18 wshOrd.Range("L1").Value = wshCmp.Range("C11") 19 wshOrd.Range("M1").Value = wshCmp.Range("E11") 20 wshOrd.Range("N1").Value = wshCmp.Range("G11") 21 wshOrd.Range("o1").Value = wshCmp.Range("i11") 22 23 With wshOrd.Sort 24 .SortFields.Clear 25 .SortFields.Add Key:=Range("W2:W16") 26 .SetRange Range("A2:W16") 27 .Apply 28 End With 29 30 wshOrd.Range("A2:H8").Copy wshCmp.Range("A25") 31 32 Set wshOrd = Nothing 33 Set wshCmp = Nothing

投稿2020/08/25 20:37

編集2020/08/27 19:30
kitasue

総合スコア314

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

qqkf

2020/08/26 13:20

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

2020/08/26 13:27

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

2020/08/26 13:56

(1)[データ比較]シートのランクした結果のNo.11とNo.12の間に罫線の部分です 「比較一覧表.xls」で使用したセルをそのまま貼り付けてためでしょうか。 (2)点数を付けて評価してますが、この点数に対して重みを付けたいです。 例えば、D Sampleの点数に関しては「×2」を考慮してランク付けをしたい。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問