VBA チェックボックスにチェックした項目だけ選んで、その中でランク付けをしたい

Question

■実現したいことは以下になります。
・手順②(画像1)で指定したファイル(比較一覧表.xls)の中にあるタイプ一覧項目(画像3)を
手順③で必要なタイプ一覧だけにチェックし、その中でランク付けし、黄色枠にも結果を表示させたい

■分からないこと
・チェックボックスにチェックを入れた後、
ファイル(比較一覧表.xls)の中にあるタイプ一覧項目をどうやってチェックし、
手順①の緑枠Sampleデータと比較一覧表ファイルのSampleデータを比較しているか分からないです。

■前提
・今までは、タイプ一覧項目を作らずに手順①の緑枠(画像1)のSampleデータと
手順②のSampleデータを比べてランク付けをしました。

画像が以下になります。

画像1 自動比較ツール.xlsmの画面 データ比較シート

画像2 自動比較ツール.xlsmの画面 順位付けシート

データ比較シートの緑枠(画像1)のSampleデータと手順②のSampleデータを絶対値の差で比較しました。
差を出した後、P2~V16でRANK関数で点数評価し、合計が一番少ないのがランク上位に表示させています。
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)

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

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

'手順④の比較開始ボタンです。
'押下すると、手順①の緑枠のデータと画像3が比較されランク付けされ上位7が表示されます。
Private Sub HikakuButton_Click()
    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("A31")
    
    Set wshOrd = Nothing
    Set wshCmp = Nothing

End Sub

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

Comments

[ttyp03]

質問の要点はコード内に書かないで、タイトルおよび質問文冒頭で説明するようにしてください。結局何がわからないのか、何を聞きたいのかがわかりづらいです。
やたらと「したい」を連発すると丸投げ判定されて回答が付きづらいですよ。

[qqkf]

質問が分かりづらくて申し訳ございません。
再編集しました。
実現したいこと分からないことを冒頭で纏めましたのでご確認お願いします。

Answer 1

動作確認お願いします。

###[データ比較]シートのコントロール設定

• [abc_1]チェックボックス

ActiveXのチェックボックスで作成
(オブジェクト名)=chkTypeList1

• [abc_2]チェックボックス

ActiveXのチェックボックスで作成
(オブジェクト名)=chkTypeList2

• [def_1]チェックボックス

ActiveXのチェックボックスで作成
(オブジェクト名)=chkTypeList3

• [def_2]チェックボックス

ActiveXのチェックボックスで作成
(オブジェクト名)=chkTypeList4

• [比較開始]ボタン

ActiveXのボタンで作成
(オブジェクト名)=btnComparisonStart

※フォームコントロールではないので注意してください。

###VBAコード群

データ比較シートに記載

Private Sub btnComparisonStart_Click()
'-------------------------------------------------------------------------------
'   btnComparisonStart_Click
'   説明
'       比較開始ボタン クリック時
'-------------------------------------------------------------------------------
    Call StartComparison

End Sub

標準モジュールに記載

Public Sub StartComparison()
'-------------------------------------------------------------------------------
'   StartComparison
'   説明
'       比較開始
'-------------------------------------------------------------------------------
    
    Dim wsDataCmp       As Worksheet    ' データ比較シート
    Dim wsRank          As Worksheet    ' 順位付けシート
    Dim appCmp          As Excel.Application
    Dim wbCmp           As Workbook     ' 比較一覧表.xls ブック
    Dim wsCmp           As Worksheet    ' _比較一覧シート
    Dim rngCells        As Range        ' セル範囲
    Dim strXLSPath      As String       ' 比較一覧表.xlsのパス
    Dim intIndex        As Integer      ' インデックス
    Dim strTypeList()   As String       ' タイプ一覧
    Dim intTypeIndex    As Integer      ' タイプ一覧インデックス
    Dim objOLE          As OLEObject    ' OLEオブジェクト(コントロール)
    Dim lngGetRowIndex  As Long         ' 取得行位置
    Dim lngGetRowMax    As Long         ' 取得行位置最大
    Dim lngGetColIndex  As Long         ' 取得列位置
    Dim lngSetRowIndex  As Long         ' 設定行位置
    Dim lngSetColIndex  As Long         ' 設定列位置
    Dim varValue        As Variant      ' 値等
    Dim blnIsCopy       As Boolean      ' コピー判定
    Dim strFormula      As String       ' 数式

On Error GoTo StartComparison_Err:
    
    '----- 各シートの参照設定
    Set wsDataCmp = Application.ActiveWorkbook.Worksheets("データ比較")
    Set wsRank = Application.ActiveWorkbook.Worksheets("順位付け")
    
    '----- チェックボックスがOnのタイプ一覧の検索値取得
    intTypeIndex = -1
    For Each objOLE In wsDataCmp.OLEObjects
        '----- OLEオブジェクト(コントロール)の名前が"chkTypeList"で始まる場合
        If objOLE.Name Like "chkTypeList*" Then
            '----- チェックボックスがOnの場合
            If objOLE.Object.Value = True Then
                '----- チェックボックスのラベルの値(検索値)をタイプ一覧に登録
                intTypeIndex = intTypeIndex + 1
                ReDim Preserve strTypeList(0 To intTypeIndex)
                strTypeList(intTypeIndex) = objOLE.Object.Caption
            End If
        End If
    Next objOLE
    
    '----- 1.「自動比較ツール.xlsm」の[データ比較]シートの上位7行をクリアする。
    wsDataCmp.Range("A31:I37").ClearContents
    
    '----- 2.「自動比較ツール.xlsm」の[順位付け]シートをクリアする。
    Set rngCells = wsRank.UsedRange
    rngCells.ClearContents
    rngCells.Cells(1, 1).Value = "No."
    rngCells.Cells(1, 2).Value = "A Sample"
    rngCells.Cells(1, 3).Value = "B Sample"
    rngCells.Cells(1, 4).Value = "C Sample"
    rngCells.Cells(1, 5).Value = "D Sample"
    rngCells.Cells(1, 6).Value = "E Sample"
    rngCells.Cells(1, 7).Value = "F Sample"
    rngCells.Cells(1, 8).Value = "G Sample"
    rngCells.Cells(1, 9).Value = "タイプ一覧"
    
    '----- 3. 格納先セルにあるフルパスから「比較一覧表.xls」を開く
    strXLSPath = wsDataCmp.Range("C15").Value ' 比較一覧表.xlsのパス
    Set appCmp = New Excel.Application
    Set wbCmp = appCmp.Workbooks.Open(strXLSPath, ReadOnly:=True)

    '----- 4.「比較一覧表.xls」の中には[1_比較一覧][2_比較一覧][3_比較一覧]シートが存在する
    lngSetRowIndex = 1  ' 設定行位置
    lngSetColIndex = 1  ' 設定列位置
    For intIndex = 1 To wbCmp.Sheets.Count
        If wbCmp.Sheets(intIndex).Name Like "*_比較一覧" Then
            Set wsCmp = wbCmp.Sheets(intIndex)
            '----- 5. 各シートの比較一覧表からタイプ一覧のチェックボックスで選択された値のみ抽出し、
            '      　「自動比較ツール.xlsm」の[順位付け]シートに2行目からコピーする。
            For lngGetRowIndex = 4 To wsCmp.UsedRange.Rows.Count
                '----- 対象行取得
                varValue = wsCmp.Range(wsCmp.Cells(lngGetRowIndex, 1), wsCmp.Cells(lngGetRowIndex, 9)).Value
                
                '----- 行終了の判断はNo.セルに値が無かったらとする｡
                if Isnull(varValue(0)) or len(varValue(0)) = 0 Then Exit For

                '----- タイプ一覧によるコピー判定
                blnIsCopy = False
                If (Not strTypeList) = True Then
                    '----- チェックボックスがすべてOffの場合
                    blnIsCopy = True
                Else
                    '----- タイプ一覧による絞り込みがある場合
                    For intTypeIndex = 0 To UBound(strTypeList)
                        If varValue(1, 9) = strTypeList(intTypeIndex) Then
                            blnIsCopy = True
                            Exit For
                        End If
                    Next intTypeIndex
                End If
            
                '----- 行コピー判定
                If blnIsCopy = True Then
                    '----- コピー先範囲取得
                    lngSetRowIndex = lngSetRowIndex + 1     ' 設定行位置
                    Set rngCells = wsRank.Range(wsRank.Cells(lngSetRowIndex, 1), wsRank.Cells(lngSetRowIndex, 9))
                    
                    '----- 値のコピー
                    rngCells.Value = varValue
                    
                    '----- 書式設定
                    rngCells.Columns(2).NumberFormatLocal = "0.00000" 'B列
                    rngCells.Columns(3).NumberFormatLocal = "0.00000" 'C列
                    rngCells.Columns(4).NumberFormatLocal = "0.00000" 'D列
                    rngCells.Columns(5).NumberFormatLocal = "0.00000" 'E列
                    rngCells.Columns(6).NumberFormatLocal = "0.00000" 'F列
                    rngCells.Columns(7).NumberFormatLocal = "0.00000" 'G列
                    rngCells.Columns(8).NumberFormatLocal = "0.00000" 'H列
                
                End If
            
            Next lngGetRowIndex
            
        End If
    Next intIndex
    lngGetRowMax = lngSetRowIndex

    '----- 6. コピー処理を3シート分行ったら「比較一覧表.xls」を閉じる
    Call CloseExcel(appCmp, wbCmp)      ' 比較一覧表.xls ブック

    '----- 7.「自動比較ツール.xlsm」の[順位付け]シートに[データ比較]シートの比較元の値を設定する。
    wsRank.Range("J1").Value = wsDataCmp.Range("C10").Value
    wsRank.Range("K1").Value = wsDataCmp.Range("E10").Value
    wsRank.Range("L1").Value = wsDataCmp.Range("G10").Value
    wsRank.Range("M1").Value = wsDataCmp.Range("C11").Value
    wsRank.Range("N1").Value = wsDataCmp.Range("E11").Value
    wsRank.Range("O1").Value = wsDataCmp.Range("G11").Value
    wsRank.Range("P1").Value = wsDataCmp.Range("I11").Value
    
    '----- 8.「自動比較ツール.xlsm」の[順位付け]シートに計算式を設定する。
    For lngGetRowIndex = 2 To lngGetRowMax
        For lngGetColIndex = 10 To 24
            Select Case lngGetColIndex
                Case 10 To 16
                    '----- ABS
                    strFormula = "=ABS(" & Chr(lngGetColIndex + 56) & lngGetRowIndex & "-" & Chr(lngGetColIndex + 64) & "$1)"
                Case 17 To 23
                    '----- RANK
                    strFormula = "=RANK(" & Chr(lngGetColIndex + 57) & lngGetRowIndex & "," & Chr(lngGetColIndex + 57) & "$2:" & Chr(lngGetColIndex + 57) & "$" & lngGetRowMax & ",1)"
                Case 24
                    '----- SUM
                    strFormula = "=SUM(P" & lngGetRowIndex & ":V" & lngGetRowIndex & ")"
            End Select
            '----- 数式設定
            wsRank.Cells(lngGetRowIndex, lngGetColIndex).Formula = strFormula
        Next lngGetColIndex
    Next lngGetRowIndex
    
    '----- 9. 「自動比較ツール.xlsm」の[順位付け]シートを2行目からW列を昇順で並び替える
    wsRank.Sort.SortFields.Clear
    wsRank.Sort.SortFields.Add Key:=Range("X2:X" & lngGetRowMax & ""), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wsRank.Sort
        .SetRange Range("A2:X" & lngGetRowMax & "")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    '----- 10.「自動比較ツール.xlsm」の[順位付け]シート上位7行の内容を[データ比較]シートにコピーする
    wsDataCmp.Range(wsDataCmp.Cells(31, 1), wsDataCmp.Cells(37, 9)).Value = wsRank.Range(wsRank.Cells(2, 1), wsRank.Cells(8, 9)).Value

    Call MsgBox("比較処理が完了しました。", vbOKOnly + vbInformation, "自動比較ツール")

StartComparison_End:
On Error Resume Next
    
    '----- 終了処理
    Set wsDataCmp = Nothing             ' データ比較シート
    Set wsRank = Nothing                ' 順位付けシート
    Set wsCmp = Nothing                 ' _比較一覧シート
    Call CloseExcel(appCmp, wbCmp)   ' 比較一覧表.xls ブック
    
Exit Sub

'----- エラー処理
StartComparison_Err:
    Call MsgBox("ErrNo:" & Err & vbNewLine & Error, vbOKOnly + vbCritical, "StartComparison")
Resume StartComparison_End:
End Sub

Private Sub CloseExcel(ByRef app As Excel.Application, ByRef wb As Workbook)
'-------------------------------------------------------------------------------
'   CloseExcel
'   説明
'       Excelを閉じる(SAVEなし)
'   パラメータ
'       app             : Excelアプリケーション
'       wb              : ワークブック
'-------------------------------------------------------------------------------
    
On Error GoTo CloseExcel_Err:

    '----- ブックを閉じる
    If Not wb Is Nothing Then
        Set app = wb.Application
        app.DisplayAlerts = False
        Call wb.Close
        app.DisplayAlerts = True
        Set wb = Nothing
    End If
    
    '----- Excelを閉じる
    If Not app Is Nothing Then
        app.Quit
        Set app = Nothing
    End If

CloseExcel_End:
On Error Resume Next
Exit Sub

'----- エラー処理
CloseExcel_Err:
    Call MsgBox("ErrNo:" & Err & vbNewLine & Error, vbOKOnly + vbCritical, "CloseExcel")
Resume CloseExcel_End:
End Sub

Comments

[qqkf]

コーディングありがとうございます。
動作確認できました。
[順位付け]シートをVBA側で処理コーディングまで行ったんですね、ありがとうございます。
このプログラムは、RANK関数に重みをつけることは可能でしょうか。
一回目の処理手順で気付くのが遅くて申し訳ございません。
チェックボックスを作る前に、[順位付け]シートのRANK関数を使って重みも入れて行っていました。
例えば、A Sampleの点数に関しては「×2」を考慮してランク付けしたいときは、
セルQ1に「2」を入力して、
Q2：=RANK(J2,J$2:J$16,1)*Q$1
:(略)
Q16：=RANK(J16,J$2:J$16,1)*Q$1
で行っていました。

また、[順位付け]シートのヘッダー部分A列はクリアしないで残したいのですが、可能でしょうか。

[kuma_kuma_]

> 例えば、A Sampleの点数に関しては「×2」を考慮してランク付けしたいときは、
これをするなら[データ比較]シートに「重み」項目を追加して比較値をコピーする時に
同じように1行目にコピーするようにしたほうが良いです。

> [順位付け]シートのヘッダー部分A列はクリアしないで
1行目のA列からI列に関してはクリア後再設定していますが
「画像2 自動比較ツール.xlsmの画面 順位付けシート」を見るともともと空白だったはずです。
デバックの関係で付けた機能ですがA列が"No."で問題ありますか？

あと修正は可能ですが、もうすでに「開発依頼」のレベルにきています。
ここはあくまで「わからない事を教えてもらう場」ですので誤解なきよう

[qqkf]

すいません、実現したいことができたのでクローズいたします。
ここからは、地道に調べて改造していきたいと思います。
最後まで携わっていただきありがとうございました。

Answer 2

プロシジャの最後の方で、[順位付け]シートの値を[データ比較]シートへコピーする際に、フィルターを使用してはいかがでしょうか。
なお、
(1) チェックボックスは、フォームコントロールのチェックボックスとし、名前は、CheckBox1, CheckBox2, CheckBox3, CheckBox4としました。
(2) チェックボックスのテキスト(Caption)をそれぞれ、abc_1, abc_2, def_1, def_2としました。
(3) [順位付け]シートのI列を「タイプ一覧」の列として挿入しました。よって、それ以降の列が右に１列ずれます。

Private Sub HikakuButton_Click()
    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:i8").Copy wshOrd.Range("A" & i * 5 - 3)
    Next i
    wbk.Close SaveChanges:=False: Set wbk = Nothing

    wshOrd.Range("J1").Value = wshCmp.Range("C10")
    wshOrd.Range("K1").Value = wshCmp.Range("E10")
    wshOrd.Range("L1").Value = wshCmp.Range("G10")
    wshOrd.Range("M1").Value = wshCmp.Range("C11")
    wshOrd.Range("N1").Value = wshCmp.Range("E11")
    wshOrd.Range("o1").Value = wshCmp.Range("G11")
    wshOrd.Range("P1").Value = wshCmp.Range("i11")

    wshOrd.Range("A1").AutoFilter
    With wshOrd.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("X2:X16")
        .SetRange Range("A2:X16")
        .Apply
    End With
    
    Dim strCriteria() As String
    Dim j As Long
    j = -1
    For i = 1 To 4
        If wshCmp.CheckBoxes("CheckBox" & i).Value = xlOn Then
            j = j + 1
            ReDim Preserve strCriteria(j)
            strCriteria(j) = wshCmp.CheckBoxes("CheckBox" & i).Caption
        End If
    Next i
    
    If j >= 0 Then
        wshOrd.Range("A1:i16").AutoFilter Field:=9, Criteria1:=strCriteria, Operator:=xlFilterValues
    End If
        
    wshOrd.Range("A30:i45").ClearContents
    wshOrd.Range("A1").CurrentRegion.Resize(, 9).Copy wshOrd.Range("A30")
    wshCmp.Range("A31:i37").Value = wshOrd.Range("A31:i37").Value
    wshOrd.Range("A30:i45").ClearContents
    wshOrd.Range("A30:i45").ClearFormats
    
    Set wshOrd = Nothing
    Set wshCmp = Nothing

End Sub

Comments

[qqkf]

前回に引き続き回答ありがとうございます。
(1)のチェックボックスですが、フォームコントロールで作成しましたが、
「指定した名前のアイテムが見つかりませんでした。」エラーメッセージがでました。
どうやってチェックボックスを作成されたのでしょうか。

[kitasue]

名前をCheckBox1とかに変更しましたか？

[qqkf]

変更しましたが、同じエラーメッセージが表示されます。
手順は開発タブ→挿入→フォームコントロール→チェックボックス(フォームコントロール)よかったですか？

[kitasue]

はい、それでOKです。チェックボックスを作成した直後なら、左上のA1セルの上あたりに「チェック 1」とか表示されていると思いますが、そこにカーソルを入れて「CheckBox1」に変更します。
すでに作成済みなら、チェックボックスを右クリックすると、同様の処理が可能です。
下のサイトはボタンの例です。
http://www.k1simplify.com/vba/tipsleaf/callbuttonname.html

[kitasue]

もし、他にチェックボックスが存在せず、今後も増やす予定が無いのであれば、
For i = 1 To 4
If wshCmp.CheckBoxes("CheckBox" & i).Value = xlOn Then
j = j + 1
ReDim Preserve strCriteria(j)
strCriteria(j) = wshCmp.CheckBoxes("CheckBox" & i).Caption
End If
Next i
の部分を
Dim CheckBox
For Each CheckBox In wshCmp.CheckBoxes
If CheckBox.Value = xlOn Then
j = j + 1
ReDim Preserve strCriteria(j)
strCriteria(j) = CheckBox.Caption
End If
Next CheckBox
に変更しても動きます。

[qqkf]

動作確認できました。
同じ動作(例：全部チェックしたときなど)を何回も行うと順位が毎回変動してしまいます。
また、比較後、[順付け]シートを見にいくと同じものが下にコピーされていました。

[qqkf]

順位が毎回変動ですが、こちらの貼り付けミスでしたので、解決です。
[順付け]シートを見にいくと同じものが下にコピーはされます。

[kitasue]

同じものが下にコピーされるのは、そこを作業領域としているからで、正常な動作です。

[qqkf]

作業後は、クリアしたいのですが可能でしょうか。

[kitasue]

wshCmp.Range("A31:i37").Value = wshOrd.Range("A31:i37").Value
の後ろに２行追加しました。

[qqkf]

コーディングありがとうございます。
無事に実現したいことができました。

Answer 3

一回まとめました。
この処理手順で問題ありませんか？

ファイル構成

• 自動比較ツール.xlsm
  処理実行用ファイル
  [データ比較]シート
  処理を行うためのシート
  [順位付け]シート
  比較データの順位付けを行うためのシート

• 比較一覧表.xls
  データが格納されているファイル
  [1_比較一覧]シート
  比較対象となるデータが記載されている(n行)
  [2_比較一覧]シート
  比較対象となるデータが記載されている(n行)
  [3_比較一覧]シート
  比較対象となるデータが記載されている(n行)

実行までの工程
1.自動比較ツール.xlsmの[データ比較]シートのオレンジおよび緑の項目に比較元となる値を設定
2.格納先に「比較一覧表.xls」のフルパスを指定
3.タイプ一覧のチェックボックスで比較一覧表の対象行を選択する
4.「比較開始」ボタンを押下するとメインの処理が動く

メインの処理
1.「自動比較ツール.xlsm」の[データ比較]シートの上位7行をクリアする。
2.「自動比較ツール.xlsm」の[順位付け]シートをクリアする。
3.格納先セルにあるフルパスから「比較一覧表.xls」を開く
4.「比較一覧表.xls」の中には[1_比較一覧][2_比較一覧][3_比較一覧]シートが存在する
5.各シートの比較一覧表からタイプ一覧のチェックボックスで選択された値のみ抽出し、
「自動比較ツール.xlsm」の[順位付け]シートに2行目からコピーする。
行終了の判断はNo.セルに値が無かったらとする。
6.コピー処理を3シート分行ったら「比較一覧表.xls」を閉じる
7.「自動比較ツール.xlsm」の[順位付け]シートに[データ比較]シートの比較元の値を設定する。

セル対比表

順位付け	データ比較
I1	C10
J1	E10
K1	G10
L1	C11
M1	E11
N1	G11
O1	I11

8.「自動比較ツール.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)

9.「自動比較ツール.xlsm」の[順位付け]シートを2行目からW列を昇順で並び替える
10.「自動比較ツール.xlsm」の[順位付け]シート上位7行の内容を[データ比較]シートにコピーする

Comments

[kuma_kuma_]

自動比較ツール.xlsmの[データ比較]シートにあるデータファイル「読み込みデータ.xls」は
なにか使用しているのですか？

[qqkf]

現在使用していないです。
これはデータファイル選択ボタン押下後、「読み込みデータ.xls」にあるSampleデータをオレンジ枠および緑枠に自動で貼り付けを行います。
オレンジ枠及び緑枠は、手動でも入力したいので無視していいです。

処理の手順ですが、メインの処理
1.「自動比較ツール.xlsm」の[データ比較]シートの上位7行をクリアする。
2.「自動比較ツール.xlsm」の[順位付け]シートをクリアする。
のクリアするというどういう意味でしょうか。

[kuma_kuma_]

>クリアするというどういう意味でしょうか。
前回実行した時の値が残っている可能性がありますので行を削除しておきます。

Answer 4

すみません読解力がなくって

手順③に比較したい項目にチェックを入れ、その中で比較をしたいです。

この比較は「なに」と「なに」を比較したいのですか？
(abc_1,abc_2,def_1,def_2の意味がつかめません)
それが判れば「タイプ一覧」に設定できるのですが...

あと処理自体は「比較開始」ボタンを押下したときではなく
手順③の「タイプ一覧」のチェックボックスをOn,Offしたときの動作なのですか？
チェックボックスをOn,Off判定なら

If abc_1.Value = True Then
    'abc_1がOnの時
Else
    'abc_1がOffの時
End If

で判りますが...

Comments

[qqkf]

回答ありがとうございます。
質問が分かりづらくて申し訳ございません。
手順3でチェックしたタイプ一覧に対して、手順1の緑枠のSampleデータと比較一覧表.xlsの中にあるSampleデータを比較をしたいです。
質問を再編集したので併せて確認お願いします。

[kuma_kuma_]

「画像3　比較一覧表.xlsの画面」で見ると1シートに対して複数比較一覧表が設定されているように見えるのですがこのような登録がされているのですか？
あと比較一覧表は必ず5行なのでしょうか？

[qqkf]

いいえ、本来ならシートごとに記載しています。
画像3は、それを1シートに纏めました。
シート1は、"1_比較一覧"、シート2は、"2_比較一覧"、シート3は、"3_比較一覧"です。

[kuma_kuma_]

画像3を張り替える事をオススメします。

[qqkf]

画像3を貼り替えました。
比較一覧表の行数ですが、現段階では5行です。
今後は、それぞれのシートに行の増減させたいと考えています。