VBA チェックボックスにチェックが入ったときに対象項目の数値以上で比較を行いたい

■実現したいこと
・画像1の手順③について
チェックボックスにチェックが入った場合、手順①で入力したH Sample数値以上で比較を実現させたいです。
このチェックを行うことで、手順②で行った読み込み一覧ファイルのH Sample項目だけその数値以上で比較されます。

■現状
手順③以外のプログラムは作成できました。
各シートについて
・[数値比較]シート

以下、手順の説明になります。
手順①：それぞれの項目に対して手動入力を行うところです。

　手順②：比較対象データファイルをセットするところです。
①の項目が集約されたデータ一覧表です。

　手順③：項目H Sampleで入力された数値以上で比較したい場合は、チェックを入れます。
例：H Sampleに100と入力された場合は、それ以上で比較するようになります。

　手順④：①と②を[順位付け]シートで比較し、手順②の比較対象データファイルの近いデータを29行目から33行目に結果が表示されます。
上位5位表示になります。

・[順位付け]シート
手順①と②を絶対値の差で出して、RANK関数で順位付けさせます。
A Sample～H Sampleまであるためそれぞれで順位付けし、合計点数が少なければ上位5位にランクインされます。

画像が以下になります。

画像1
ファイル名：数値自動比較.xlsm
この画面で、各項目に数値を入力し、読み込み一覧ファイルから近いデータを上位5でランク付けして表示させます。

画像2
手順④の"一覧表の表示"ボタン押すと、このシートで比較され、
[数値比較]シートに上位5位の結果が表示されます。

コードが以下になります。
コメント部分に今回のチェックボックスにチェックを入れた動作を書いたのですが、
上手く比較できない状態です。。

VBA
1Private Sub CommandButton2_Click()
2'-------------------------------------------------------------------------------
3'   CommandButton2_Click
4'   ボタン名：一覧表を表示ボタン
5'-------------------------------------------------------------------------------
6    Dim wbk As Workbook
7    Dim wshCmp As Worksheet
8    Dim wshOrd As Worksheet
9    Dim lngSheetNum As Long
10    Dim lngRowsCount As Long
11    Dim i As Long
12    
13    Set wshCmp = Worksheets("数値比較")
14    Set wshOrd = Worksheets("順位付け")
15    
16    Set wbk = Workbooks.Open(wshCmp.Range("G10").Value, ReadOnly:=True) '読み取り専用で開く
17    
18    '----- サンプル読み込みデータを数値自動比較ファイルの[順位付け]シートに貼り付ける
19    For lngSheetNum = 1 To 4
20        With wbk.Worksheets("Test" & lngSheetNum).Range("A3").CurrentRegion
21            .Offset(1).Resize(.Rows.Count - 1, 9).Copy wshOrd.Range("A3").Offset(lngRowsCount)
22            lngRowsCount = lngRowsCount + .Rows.Count - 1
23        End With
24    Next
25    
26    '----- ブックを保存しないで閉じ、オブジェクトwbkの参照を解除
27    wbk.Close SaveChanges:=False: Set wbk = Nothing
28    
29    wshOrd.Range("B2").Value = wshCmp.Range("C5")   'A Sample
30    wshOrd.Range("C2").Value = wshCmp.Range("E5")   'B Sample
31    wshOrd.Range("D2").Value = wshCmp.Range("G5")   'C Sample
32    wshOrd.Range("E2").Value = wshCmp.Range("I5")   'D Sample
33    wshOrd.Range("F2").Value = wshCmp.Range("C6")   'E Sample
34    wshOrd.Range("G2").Value = wshCmp.Range("E6")   'F Sample
35    wshOrd.Range("H2").Value = wshCmp.Range("G6")   'G Sample
36    wshOrd.Range("I2").Value = wshCmp.Range("I6")   'H Sample
37    
38    wshOrd.Range("A1").AutoFilter
39    
40    '----- [順位付け]シートを点数で評価し、昇順に並び替え
41    With wshOrd.Sort
42        .SortFields.Clear
43        .SortFields.Add Key:=Range("Z3:Z22")
44        .SetRange Range("A3:Z22")
45        .Apply
46    End With
47
48'    '----- チェックボックスにチェック入れたものに対して、フィルターを行う
49'    Dim strCriteria() As String    '動的配列(H Sample)
50'    Dim j As Long
51'    Dim k As Long
52'    Dim l As Long
53
54'    j = -1
55'    k = -1
56'    l = -1
57
58'    If wshCmp.CheckBoxes("CheckBox1").Value = xlOn Then
59'       j = j + 1
60'       ReDim Preserve strCriteria(j)  '動的配列宣言
61'       strCriteria(j) = wshCmp.CheckBoxes("CheckBox1").Caption
62'    End If
63
64'    '----- H Sampleのフィルター設定
65'    If l >= 0 Then
66'        With wshOrd.Range("A2:I22")
67'            .AutoFilter Field:=9, Criteria1:=""  'どうやって比較設定したらいいか分からない
68'        End With
69'    End If
70
71    '----- チェックボックスにチェック入れた後、入れたものに対して[数値比較]シートに貼り付け及びセルクリア
72    wshOrd.Range("A100:I123").ClearContents
73    wshOrd.Range("A1").CurrentRegion.Resize(, 9).Copy wshOrd.Range("A101")
74    wshCmp.Range("A29:H33").Value = wshOrd.Range("B103:I107").Value
75    wshOrd.Range("A100:I123").ClearContents
76    wshOrd.Range("A101:I102").Interior.ColorIndex = 0
77
78    With wshOrd.Range("A102:I102")
79        .Borders(xlEdgeBottom).LineStyle = xlContinuous
80        .Borders(xlEdgeBottom).Weight = xlHairline
81    End With
82
83    '----- オブジェクトwshOrd, wshCmpの参照を解除
84    Set wshOrd = Nothing
85    Set wshCmp = Nothing
86    
87End Sub
88

ご教授いただけると幸いです。
よろしくお願いいたします。

FromMZ1500

2021/04/07 22:58

H Sampleに100と入力され、とあるのに、cmpシートのH29～33の値をみたら0.6とか100とかけ離れた数字が並んでて、？です。質問内容はたくさん書いてありますがるけど、結局、どういう処理を実現したいのかが、いまいち見えてこない、わかりにくい気がします。たくさん書いてあるけど、核心部の内容として、そこが薄いのです。どうすれば伝わるか、。答えやすいかを再検討されたほうがよいような気がします。

qqkf

2021/04/08 02:31

FromMZ1500 様修正の依頼ありがとうございます。先ほど、修正を行いましたので確認をお願いいたします。結局ところ、手順③にチェックが入ったらその項目だけ対象の数値以上で比較させたいだけです。「cmpシートのH29～33の値をみたら0.6とか100とかけ離れた数字が並んでて、？です。」の文ですが、これは、手順②でセットしたファイルの中身です。このファイルの中で手順①に近いデータを比較し、上位5位の結果を出します。分かりづらい質問で申し訳ございません。

FromMZ1500

2021/04/08 03:51

完成版は、チェックボックスが A Sample～H Sampleまでの8個ならぶのですか？

FromMZ1500

2021/04/08 03:57

書きかけのソースの ' Dim j As Long ' Dim k As Long ' Dim l As Long は何を想定しての変数でしょうか？

FromMZ1500

2021/04/08 04:00

最初の質問がまだわかっていませんが、100と大小比較する数値は、どの値でしょうか？（あなたはこの質問の回答者には向いてない、と思われたら、この修正依頼はスルーしていただいて結構です。）

qqkf

2021/04/08 07:27

こちらで自己解決しました。分かりづらい質問で申し訳ございませんでした。。

行動規範の内容に同意します

回答1件

自己解決

If文を使い入力された値に対してフィルター設定できました。
以下、コードになります。

VBA
1With wshOrd.Sort
2        .SortFields.Clear
3        .SortFields.Add Key:=Range("Z3:Z22")
4        .SetRange Range("A3:Z22")
5        .Apply
6    End With
7
8'----- ここにフィルター設定を行いました。
9If wshCmp.CheckBoxes("CheckBox1").Value = xlOn Then
10        With wshOrd.Range("A2:Z22")
11            .AutoFilter Field:=9, Criteria1:=">=" & Range("I6")
12        End With
13    End If
14'----- ここまで
15
16'----- チェックボックスにチェック入れた後、入れたものに対して[数値比較]シートに貼り付け及びセルクリア
17    wshOrd.Range("A100:I123").ClearContents
18    wshOrd.Range("A1").CurrentRegion.Resize(, 9).Copy wshOrd.Range("A101")
19    ・・・
20