Option Explicit
 
Sub SearchAcrossBooks_OnePass()
    Dim wsMain As Worksheet
    Dim lastrow As Long, r As Long, endRow As Long
    Dim dict As Object
    Dim key As Variant, v As Variant
    Dim Path As String, f As String
    Dim wb As Workbook, ws As Worksheet
    Dim rng As Range
    Dim data As Variant
    Dim i As Long, j As Long
    Dim sc As Boolean, ev As Boolean, calc As XlCalculation
    Dim cnt As Long
    Dim FDL As FileDialog
    Dim selFolder As String
 
    ' フォルダ選択ダイアログを作成
    Set FDL = Application.FileDialog(msoFileDialogFolderPicker)
 
    ' ダイアログの初期フォルダ設定（オプション）
    'FDL.InitialFileName = "C:\"
 
    ' ダイアログ表示し、フォルダが選択されたか確認
    If FDL.Show = -1 Then
        ' 選択されたフォルダパスを取得
        selFolder = FDL.SelectedItems(1)
    Else
        'フォルダ選択がキャンセルの場合
        Exit Sub
    End If
 
    Set wsMain = ThisWorkbook.Sheets("判定")
 
    lastrow = wsMain.Cells(wsMain.Rows.Count, "E").End(xlUp).Row
    If lastrow < 2 Then Exit Sub
 
    Set dict = CreateObject("Scripting.Dictionary")
 
    For r = 2 To lastrow
        v = wsMain.Cells(r, "E").Value
        If Len(v) = 0 Then Exit For
        dict(CStr(v)) = 0
    Next r
    endRow = r - 1
    If dict.Count = 0 Then Exit Sub
 
    sc = Application.ScreenUpdating
    ev = Application.EnableEvents
    calc = Application.Calculation
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
 
 
 
    ' 同一フォルダ内の他ブックを集計
    Path = selFolder & "\"
    f = Dir(Path & "*.xls*")
    Do While f <> ""
        If Path & f <> ThisWorkbook.FullName Then
            On Error Resume Next
            Set wb = Workbooks.Open(Path & f, ReadOnly:=True)
            If Err.Number = 0 Then
                On Error GoTo 0
                Call CountInWorkbook(wb, dict)
                wb.Close SaveChanges:=False
            Else
                Err.Clear
                On Error GoTo 0
            End If
        End If
        f = Dir()
    Loop
 
    ' 結果を書き戻し
    For r = 2 To endRow
        cnt = dict(CStr(wsMain.Cells(r, "E").Value))
        Select Case cnt
        Case 0: wsMain.Cells(r, "A").Value = "×"
        Case 1: wsMain.Cells(r, "A").Value = "◯"
        Case Else: wsMain.Cells(r, "A").Value = "△"
        End Select
    Next r
 
    Application.ScreenUpdating = sc
    Application.EnableEvents = ev
    Application.Calculation = calc
 
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpTdWIgU2VhcmNoQWNyb3NzQm9va3NfT25lUGFzcygpCiAgICBEaW0gd3NNYWluIEFzIFdvcmtzaGVldAogICAgRGltIGxhc3Ryb3cgQXMgTG9uZywgciBBcyBMb25nLCBlbmRSb3cgQXMgTG9uZwogICAgRGltIGRpY3QgQXMgT2JqZWN0CiAgICBEaW0ga2V5IEFzIFZhcmlhbnQsIHYgQXMgVmFyaWFudAogICAgRGltIFBhdGggQXMgU3RyaW5nLCBmIEFzIFN0cmluZwogICAgRGltIHdiIEFzIFdvcmtib29rLCB3cyBBcyBXb3Jrc2hlZXQKICAgIERpbSBybmcgQXMgUmFuZ2UKICAgIERpbSBkYXRhIEFzIFZhcmlhbnQKICAgIERpbSBpIEFzIExvbmcsIGogQXMgTG9uZwogICAgRGltIHNjIEFzIEJvb2xlYW4sIGV2IEFzIEJvb2xlYW4sIGNhbGMgQXMgWGxDYWxjdWxhdGlvbgogICAgRGltIGNudCBBcyBMb25nCiAgICBEaW0gRkRMIEFzIEZpbGVEaWFsb2cKICAgIERpbSBzZWxGb2xkZXIgQXMgU3RyaW5nCiAgICAKICAgICcg44OV44Kp44Or44OA6YG45oqe44OA44Kk44Ki44Ot44Kw44KS5L2c5oiQCiAgICBTZXQgRkRMID0gQXBwbGljYXRpb24uRmlsZURpYWxvZyhtc29GaWxlRGlhbG9nRm9sZGVyUGlja2VyKQogICAgCiAgICAnIOODgOOCpOOCouODreOCsOOBruWIneacn+ODleOCqeODq+ODgOioreWumu+8iOOCquODl+OCt+ODp+ODs++8iQogICAgJ0ZETC5Jbml0aWFsRmlsZU5hbWUgPSAiQzpcIgogICAgCiAgICAnIOODgOOCpOOCouODreOCsOihqOekuuOBl+OAgeODleOCqeODq+ODgOOBjOmBuOaKnuOBleOCjOOBn+OBi+eiuuiqjQogICAgSWYgRkRMLlNob3cgPSAtMSBUaGVuCiAgICAgICAgJyDpgbjmip7jgZXjgozjgZ/jg5Xjgqnjg6vjg4Djg5HjgrnjgpLlj5blvpcKICAgICAgICBzZWxGb2xkZXIgPSBGREwuU2VsZWN0ZWRJdGVtcygxKQogICAgRWxzZQogICAgICAgICfjg5Xjgqnjg6vjg4Dpgbjmip7jgYzjgq3jg6Pjg7Pjgrvjg6vjga7loLTlkIgKICAgICAgICBFeGl0IFN1YgogICAgRW5kIElmCgogICAgU2V0IHdzTWFpbiA9IFRoaXNXb3JrYm9vay5TaGVldHMoIuWIpOWumiIpCgogICAgbGFzdHJvdyA9IHdzTWFpbi5DZWxscyh3c01haW4uUm93cy5Db3VudCwgIkUiKS5FbmQoeGxVcCkuUm93CiAgICBJZiBsYXN0cm93IDwgMiBUaGVuIEV4aXQgU3ViCgogICAgU2V0IGRpY3QgPSBDcmVhdGVPYmplY3QoIlNjcmlwdGluZy5EaWN0aW9uYXJ5IikKCiAgICBGb3IgciA9IDIgVG8gbGFzdHJvdwogICAgICAgIHYgPSB3c01haW4uQ2VsbHMociwgIkUiKS5WYWx1ZQogICAgICAgIElmIExlbih2KSA9IDAgVGhlbiBFeGl0IEZvcgogICAgICAgIGRpY3QoQ1N0cih2KSkgPSAwCiAgICBOZXh0IHIKICAgIGVuZFJvdyA9IHIgLSAxCiAgICBJZiBkaWN0LkNvdW50ID0gMCBUaGVuIEV4aXQgU3ViCgogICAgc2MgPSBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZwogICAgZXYgPSBBcHBsaWNhdGlvbi5FbmFibGVFdmVudHMKICAgIGNhbGMgPSBBcHBsaWNhdGlvbi5DYWxjdWxhdGlvbgogICAgQXBwbGljYXRpb24uU2NyZWVuVXBkYXRpbmcgPSBGYWxzZQogICAgQXBwbGljYXRpb24uRW5hYmxlRXZlbnRzID0gRmFsc2UKICAgIEFwcGxpY2F0aW9uLkNhbGN1bGF0aW9uID0geGxDYWxjdWxhdGlvbk1hbnVhbAoKCgogICAgJyDlkIzkuIDjg5Xjgqnjg6vjg4DlhoXjga7ku5bjg5bjg4Pjgq/jgpLpm4boqIgKICAgIFBhdGggPSBzZWxGb2xkZXIgJiAiXCIKICAgIGYgPSBEaXIoUGF0aCAmICIqLnhscyoiKQogICAgRG8gV2hpbGUgZiA8PiAiIgogICAgICAgIElmIFBhdGggJiBmIDw+IFRoaXNXb3JrYm9vay5GdWxsTmFtZSBUaGVuCiAgICAgICAgICAgIE9uIEVycm9yIFJlc3VtZSBOZXh0CiAgICAgICAgICAgIFNldCB3YiA9IFdvcmtib29rcy5PcGVuKFBhdGggJiBmLCBSZWFkT25seTo9VHJ1ZSkKICAgICAgICAgICAgSWYgRXJyLk51bWJlciA9IDAgVGhlbgogICAgICAgICAgICAgICAgT24gRXJyb3IgR29UbyAwCiAgICAgICAgICAgICAgICBDYWxsIENvdW50SW5Xb3JrYm9vayh3YiwgZGljdCkKICAgICAgICAgICAgICAgIHdiLkNsb3NlIFNhdmVDaGFuZ2VzOj1GYWxzZQogICAgICAgICAgICBFbHNlCiAgICAgICAgICAgICAgICBFcnIuQ2xlYXIKICAgICAgICAgICAgICAgIE9uIEVycm9yIEdvVG8gMAogICAgICAgICAgICBFbmQgSWYKICAgICAgICBFbmQgSWYKICAgICAgICBmID0gRGlyKCkKICAgIExvb3AKCiAgICAnIOe1kOaenOOCkuabuOOBjeaIu+OBlwogICAgRm9yIHIgPSAyIFRvIGVuZFJvdwogICAgICAgIGNudCA9IGRpY3QoQ1N0cih3c01haW4uQ2VsbHMociwgIkUiKS5WYWx1ZSkpCiAgICAgICAgU2VsZWN0IENhc2UgY250CiAgICAgICAgQ2FzZSAwOiB3c01haW4uQ2VsbHMociwgIkEiKS5WYWx1ZSA9ICLDlyIKICAgICAgICBDYXNlIDE6IHdzTWFpbi5DZWxscyhyLCAiQSIpLlZhbHVlID0gIuKXryIKICAgICAgICBDYXNlIEVsc2U6IHdzTWFpbi5DZWxscyhyLCAiQSIpLlZhbHVlID0gIuKWsyIKICAgICAgICBFbmQgU2VsZWN0CiAgICBOZXh0IHIKCiAgICBBcHBsaWNhdGlvbi5TY3JlZW5VcGRhdGluZyA9IHNjCiAgICBBcHBsaWNhdGlvbi5FbmFibGVFdmVudHMgPSBldgogICAgQXBwbGljYXRpb24uQ2FsY3VsYXRpb24gPSBjYWxjCgpFbmQgU3ViCg==