макрос.Чтение данных из 1 табл и результат действия в 2 таблице.

[Hugo121]

Нет, не так.
В коде сформирован массив "c".
Теперь нужно получить массив из Ваших упорядоченных данных, циклом в цикле сравнить эти два массива и совпадения переложить в третий массив (только суммы), который выгрузить в готовую таблицу.
Только одна итоговая выгрузка, без новых книг и таблиц. Вся сортировка в памяти, кодом.

[igsxor]

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

Нет, не так.
В коде сформирован массив "c".
Теперь нужно получить массив из Ваших упорядоченных данных, циклом в цикле сравнить эти два массива и совпадения переложить в третий массив (только суммы), который выгрузить в готовую таблицу.
Только одна итоговая выгрузка, без новых книг и таблиц. Вся сортировка в памяти, кодом.

Голова уже не варит
Я синтаксис плохо воспринимаю по коду.

HUGO выручайте,действительно вопрос остро стоит

[doober]

Ваш вопрос решается штатными средствами -сводной таблицей.

во вложении пример создания сводной таблицы при помощи ADO

[Hugo121]

Сводная неплохо, но как дальше?

Я свой код дополнил - выгружает результат как выше написал, сразу в файл 2_готовая табл.xlsx.
Т.к. так и не определились, как подвязаться к файлу "2_готовая табл.xlsx", то я сделал как мне проще:
Set gottabl = Workbooks("2_готовая табл.xlsx")
т.е. эта книга тоже уже должна быть открыта.
В процессе обнаружился косяк в данных - в Вашей "2_готовая табл.xlsx" в B7 число, а далее ниже почти до конца текст.
Поэтому в коде сравнивается текст:
If CStr(d(i, 1)) = CStr(c(ii, 1)) Then
иначе совпадения были только по 4-м кодам - первому и трём внизу.

Option Explicit

Sub Otbor()
    Dim a(), b, c, d, e, i As Long, ii As Long, j As Long, jj As Long, k As Long, temp As String
    Dim gottabl As Workbook
    Set gottabl = Workbooks("2_готовая табл.xlsx")

    a = Range("A2:I" & Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 3)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            temp = a(i, 1) & a(i, 5)
            If Not .Exists(temp) Then
                j = j + 1: .Item(temp) = j
                b(j, 1) = a(i, 1)
                b(j, 2) = a(i, 5)
                b(j, 3) = a(i, 9)
            Else
                k = .Item(temp)
                b(k, 3) = b(k, 3) + a(i, 9)
            End If
        Next
    End With



    With CreateObject("Scripting.Dictionary")

        For i = 1 To j
            temp = b(i, 1)
            If Not .Exists(temp) Then jj = jj + 1: .Item(temp) = jj
        Next

        ReDim c(1 To .Count, 1 To 4)

        For i = 1 To UBound(b)
            temp = b(i, 1)
            If Len(temp) Then
                c(.Item(temp), 1) = b(i, 1)
                Select Case b(i, 2)
                Case "Х"
                    c(.Item(temp), 2) = b(i, 3)
                Case "Г"
                    c(.Item(temp), 4) = b(i, 3)
                End Select
            End If
        Next

    End With

With gottabl.Sheets(1)
    d = .Range("B7:B" & .Range("B" & .Rows.Count).End(xlUp).Row).Value

ReDim e(1 To UBound(d), 1 To 3)

For i = 1 To UBound(d)
For ii = 1 To UBound(c)
If CStr(d(i, 1)) = CStr(c(ii, 1)) Then e(i, 1) = c(ii, 2): e(i, 3) = c(ii, 4):  Exit For
Next ii, i

 .Range("C7:E7").Resize(UBound(e)) = e
End With

End Sub

[Hugo121]

Посоревновался с ADO - сперва правил код для 2000XL:

'Public Const sCn11 = "Provider=Microsoft.ACE.OLEDB.12.0; ;Data Source="
Public Const sCn11 = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source="
'Public Const sCn12 = ";Extended Properties=""Excel 12.0;HDR=YES"";"
Public Const sCn12 = ";Extended Properties=""Excel 8.0;HDR=YES;"";"

потом засекал время:

0.34375
0.359375

0.5
0.515625

Сводная медленнее.
И как по мне - свои массивы можно крутить как угодно, с сводной сложнее.

[igsxor]

А как сделать выгрузку в эту книгу в 2 лист.И в 2ом листе изначально создать шаблон готовой табл с дополнит столбцом.Изменил немного код.

  With Workbooks.Add.Worksheets(1) 
         'With Workbooks.Open("C:\готовая_таблица.xlsx")
        .[C6] = "№№ лиц.счета_2": [D6] = "объем(х)": [F6] = "объем(г)"
        .Range("C7:F7").Resize(jj) = c
        .UsedRange.EntireColumn.AutoFit
    End With

[Hugo121]

Worksheets(2)
Может быть можно не создавать динамически кодом шаблон (т.к. если шаблон сложный, то кодом много гемора), а использовать готовый шаблон в файле.
Типа (как там в коде закомментировано)

With Workbooks.Open(FullName, ReadOnly:=True)
'делаем дело, сохраняем SaveCopyAs
.Close 0
End With

[igsxor]

Почему-то код последний не заработал.=)
Расскажи как его запус

[Hugo121]

Работает:

Sub tt()
    With Workbooks.Open("C:\temp\Книга1.xls").Worksheets(1)
        .[C6] = "№№ лиц.счета_2": [D6] = "объем(х)": [F6] = "объем(г)"
        .UsedRange.EntireColumn.AutoFit
    End With
End Sub

[igsxor]

Плин,hugo,давай по порядку.)
Создаю новый макрос,копирую твой код,дальше в какой книге его запускать.
Мне щас просто тяжело въезжать,дни напряжные были невыспался а сделать нужно.
Я уже себе и книгу заказал.Вот жду поставки.