Сравнение списка по 2 параметрам и увеличение счетчика на 1

[Radmir_Tzareff]

Доброго времени суток всем. Помогите, пожалуйста, не могу разобраться с задачкой.
Есть 2 таблицы.
1. Перечень что у кого есть.
Имя Техника
Вася Трактор
Вася Косилка
Петя Кран
Ваня Отбойник
2. Заказ
Вася Трактор
Петя Кран
Ваня Отбойник
Вася Трактор
Задача: посчитать сколько и какой техники было заказано у определенного человека.
Помогите понять принцип как это сделать.

[doober]

Учитывая,что писал в блокноте,лень создавать файл,строку запроса подкорректируете под себя.

Результат
Имя......Техника.......Количество
Ваня.....Отбойник......... 1
Вася.....Трактор...........2
Петя.....Кран................1

Private Sub CommandButton1_Click()
strSql = " SELECT Имя, Техника, Count(Техника) AS [Количество] FROM [Лист1$A1:B65000] GROUP BY Имя, Техника;"
ADO_R strSql
End Sub
Sub ADO_R_Dmitry(ByVal strSql$)
        FilePath$ = ThisWorkbook.FullName
        Dim sCon As String, FieldName As String
        Dim rs As Object, cn As Object
        Set rs = CreateObject("ADODB.Recordset")
        Set cn = CreateObject("ADODB.Connection")
        Select Case CLng(Split(Application.Version, ".")(0))
        Case Is < 12
                sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath & ";Extended Properties=""Excel 8.0;HDR=YES;IMEX=1"";"
        Case Is >= 12
                sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"
        End Select
        cn.Open sCon
        If Not cn.State = 1 Then Exit Sub
        On Error Resume Next
        Set rs = cn.Execute(strSql)
        If Err.Number <> 0 Then Exit Sub
        Лист2.Range("A1").CopyFromRecordset rs
        ADO_R = rs.GetRows
        rs.Close: cn.Close
        Set cn = Nothing: Set rs = Nothing
End Sub

;

[Radmir_Tzareff]

Спасибо doober, сегодня попробую.

[doober]

Выделенное красным удалите.

      If Err.Number <> 0 Then Exit Sub
        Лист2.Range("A1").CopyFromRecordset rs
        ADO_R = rs.GetRows
        rs.Close: cn.Close
        Set cn = Nothing: Set rs = Nothing
End Sub

[Hugo121]

Принцип может быть такой -
1. перебираем данные циклом и заносим в словарь строку "Вася Трактор", в item 1.
3. если строка уже есть в словаре - увеличиваем её item на 1.
4. в конце содержимое словаря выгружаем куда угодно.

Как вариант - к словарю параллельно "подвязать" массив, куда складывать вась и трактора, и там же считать повторы. А в словаре держать строки и их позицию в массиве. Массив в итоге выгрузить.

[Radmir_Tzareff]

Извините ребят, что-то я даже стартануть его не могу. Я макросами раньше вообще не пользовался, но думал вставлю текст и все заработает, а он мне пишет в ответ: Compile error expected end sub. Можно если не затруднит пример файлом, я хоть бы по примеру начал разбираться. А нельзя эту задачку стандартными функциями решить? Спасибо.

[doober]

Создайте файлик с записями,прикрепите к сообщению и получите готовое решение.
PS:Я за вас свою работу делать не буду

[Radmir_Tzareff]

Спасибо doober, за труды. Но я тут щас копался и нашел классную функцию делает именно то, что надо =СЧЁТЕСЛИМН(интервал1;условие1;инте рвал2;условие2). Спасибо всем за ответы. Думаю макросы начать чуть позже осваивать.

[Radmir_Tzareff]

Первая задача комплит, теперь висит вопрос, а можно ли сделать авто сортировку на страницу по количеству? А то руками приходится нажимать "сортировка" при изменении значений кол-ва заказов. Смысл в том, что бы ексель выдавал на первом месте наибольшее кол-во заказанной техники автоматом перемещая победителей вверх страницы.

[staniiislav]

Сообщение от doober

Учитывая,что писал в блокноте,лень создавать файл,строку запроса подкорректируете под себя.

Результат
Имя......Техника.......Количество
Ваня.....Отбойник......... 1
Вася.....Трактор...........2
Петя.....Кран................1

Private Sub CommandButton1_Click()
strSql = " SELECT Имя, Техника, Count(Техника) AS [Количество] FROM [Лист1$A1:B65000] GROUP BY Имя, Техника;"
ADO_R strSql
End Sub
Sub ADO_R_Dmitry(ByVal strSql$)
        FilePath$ = ThisWorkbook.FullName
        Dim sCon As String, FieldName As String
        Dim rs As Object, cn As Object
        Set rs = CreateObject("ADODB.Recordset")
        Set cn = CreateObject("ADODB.Connection")
        Select Case CLng(Split(Application.Version, ".")(0))
        Case Is < 12
                sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath & ";Extended Properties=""Excel 8.0;HDR=YES;IMEX=1"";"
        Case Is >= 12
                sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"
        End Select
        cn.Open sCon
        If Not cn.State = 1 Then Exit Sub
        On Error Resume Next
        Set rs = cn.Execute(strSql)
        If Err.Number <> 0 Then Exit Sub
        Лист2.Range("A1").CopyFromRecordset rs
        ADO_R = rs.GetRows
        rs.Close: cn.Close
        Set cn = Nothing: Set rs = Nothing
End Sub

;

Вы не могли бы расписать по строкам что в них происходит?