Sub get_stat_comp()
Dim y As Long
Dim minim As Long
Dim maxs As Long
Dim h As Long
Dim jj As Long
Dim jk As Long

With ThisWorkbook.Sheets("Статистика").Range("A2:C1000")
.Cells.ClearContents
End With

arr = Array()
filename$ = ThisWorkbook.Path & "\" & "etalon.csv"
arr = csv2arr(filename$)

If Not IsArray(arr) Then MsgBox "!!!", vbCritical, "Ошибка": Exit Sub

Set sqlcon = CreateObject("ADODB.Connection")
Set sqlrs = CreateObject("ADODB.Recordset")
Set sqltxt = CreateObject("ADODB.Command")
   
sqlcon.ConnectionString = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER=localhost; DATABASE=stat_db00A; UID=root; PWD=; OPTION=3;"
sqlcon.Open
    
sqltxt.ActiveConnection = sqlcon
sqltxt.CommandType = 1
sqltxt.CommandText = "select * from table1"
    
sqlrs.Open sqltxt
sqlrs.MoveFirst
    
y = 2
Do Until sqlrs.EOF

maxs = 0
For i = 2 To UBound(arr, 1)

minim = Int(arr(i, UBound(arr, 2)))
h = 0
    For x = 2 To UBound(arr, 2) - 1
    jj = Int(sqlrs.Fields(x - 1))
    jk = Int(arr(i, x))
    If jk = jj Then h = h + 1
    Next x
If h < minim Then GoTo a1
If h > maxs Then maxs = h
Next i

ThisWorkbook.Sheets("Статистика").Cells(y, 1) = sqlrs.Fields(0)
ThisWorkbook.Sheets("Статистика").Cells(y, 2) = sqlrs.Fields(9)
ThisWorkbook.Sheets("Статистика").Cells(y, 3) = maxs
If y > 1000 Then MsgBox "Слишком много совпадений !!!", vbCritical, "Ошибка": Exit Sub
y = y + 1
a1:
DoEvents
sqlrs.MoveNext
Loop
    
   sqlcon.Close
   MsgBox "Найдено " & y - 1 & " строк."
End Sub


Function csv2arr(Optional ByVal filename$ = "", _
                        Optional ByVal ColumnsSeparator$ = ";", _
                        Optional ByVal RowsSeparator$ = vbNewLine) As Variant

On Error Resume Next
Set fso = CreateObject("scripting.filesystemobject")
   Set ts = fso.OpenTextFile(filename$, 1, True): txt$ = ts.ReadAll: ts.Close
    Set ts = Nothing: Set fso = Nothing

    txt = Trim(txt): Err.Clear
   If txt Like "*" & RowsSeparator$ Then txt = Left(txt, Len(txt) - Len(RowsSeparator$))

    tmpArr1 = Split(txt, RowsSeparator$): RowsCount = UBound(tmpArr1) + 1
    ColumnsCount = UBound(Split(tmpArr1(0), ColumnsSeparator$)) + 1

    If Err.Number > 0 Then MsgBox "Ошибка", vbCritical: End
    ReDim arr(1 To RowsCount, 1 To ColumnsCount)

    For i = LBound(tmpArr1) To UBound(tmpArr1)
        tmpArr2 = Split(Trim(tmpArr1(i)), ColumnsSeparator$)
        For j = 1 To ColumnsCount
            arr(i + 1, j) = tmpArr2(j - 1)
        Next j
    Next i
    csv2arr = arr
End Function

sqltxt.ActiveConnection = sqlcon
sqltxt.CommandType = 1


sqltxt = "select t.id, t.descr, max( " & _
"case when t.c1=e.c1 then 1 else 0 end + " & _
"case when t.c2=e.c2 then 1 else 0 end + " & _
"case when t.c3=e.c3 then 1 else 0 end + " & _
"case when t.c4=e.c4 then 1 else 0 end + " & _
"case when t.c5=e.c5 then 1 else 0 end + " & _
"case when t.c6=e.c6 then 1 else 0 end + " & _
"case when t.c7=e.c7 then 1 else 0 end + " & _
"case when t.c8=e.c8 then 1 else 0) from table1 t " & _
"join etalon e on " & _
"case when t.c1=e.c1 then 1 else 0 end + " & _
"case when t.c2=e.c2 then 1 else 0 end + " & _
"case when t.c3=e.c3 then 1 else 0 end + " & _
"case when t.c4=e.c4 then 1 else 0 end + " & _
"case when t.c5=e.c5 then 1 else 0 end + " & _
"case when t.c6=e.c6 then 1 else 0 end + " & _
"case when t.c7=e.c7 then 1 else 0 end + " & _
"case when t.c8=e.c8 then 1 else 0 end >=e.min " & _
"group by t.id, t.descr " & _
"having count(*)=(select count(*) from t_etalon);"

sqlrs.Open sqltxt