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

[Hugo121]

Ну давай.
Только я скоро домой, так что будет пауза...
Распиши подробно, что нужно сделать - от этого макрос будет сильно зависеть

[igsxor]

Открыл новую книгу в ней открыл основн.табл.,создал макрос,ввёл твой код

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("C:\Documents and Settings\dell_xp\Мои документы\Excel_forum\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

Запустил run,выдал ошибку
Run time error '9':
Subscript out of range.

До этого ругался на вот эту строчку :
Set gottabl = Workbooks("2_готовая табл.xlsx")

[Hugo121]

Надо видеть, на какой строке ошибка, вернее на что именно ругается.
Тут должно ругаться:

Set gottabl = Workbooks("C:\Documents and Settings\dell_xp\Мои документы\Excel_forum\2_готовая табл.xlsx")

И вот эти вопросительные знаки тоже в коде?

Case "?"
c(.Item(temp), 2) = b(i, 3)
Case "?"

Всё, пауза на часик-полтора...

[igsxor]

Всё расписал во вложенном файле.Раньше не мог войти,сервер перегружен был судя по всему.

[Hugo121]

Так ведь в http://www.programmersforum.ru/showp...4&postcount=34
уже всё это реализовано.
Там только обратите внимание на строки:
"Т.к. так и не определились, как подвязаться к файлу "2_готовая табл.xlsx", то я сделал как мне проще:
Set gottabl = Workbooks("2_готовая табл.xlsx")
т.е. эта книга тоже уже должна быть открыта."

Но сейчас на всякий случай ещё перепроверю на приложенных файлах...
Да, всё работает без переделок.
Только важно - в строке
Set gottabl = Workbooks("2_готовая табл.xlsx")
должно быть указано имя Вашего сводного файла, он должен быть открыт, и код нужно запускать при активном листе с обрабатываемыми данными.

[igsxor]

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

Так ведь в http://www.programmersforum.ru/showp...4&postcount=34
уже всё это реализовано.
ми.

Ссылка не рабочая

[Hugo121]

У меня открывается...
Это 34-е сообщение этой темы. Берите код целиком и помещайте в любой стандартный модуль. Хотя может и вообще в любой можно, не проверял.

[igsxor]

Всё код откомпилировался чистенко вроде)
Компилировал в 1_почти_готовая..
Дальше его нужно сохранить или как?

[igsxor]

Пробовал.
Всё запустилось,но не подходит,так как данные не правильные.
Как мне просто выгрузить в туже книгу где и начальные данные?
Или можно только в новую?

[igsxor]

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

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

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

Доброго времени.

Прошу прошения,что проигнорировал.
Только попробовал ваш код.Просмотрел но не понял его.)
Как убрать кнопку Жми меня.
Кнопку я попробую вывести потом на панель управления.
И если не трудно объясни как после выгрузки сделать сводную таблицу)