Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.03.2011, 20:49   #11
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Я обновил вложенный файл посмотрите пожалуйста.

Там для примера указана урезанная таблица.
Начальная будет примерно на 300 строк.
Главное чтобы код считывал паправильно все строки
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 20:54   #12
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Цитата:
Сообщение от Hugo121 Посмотреть сообщение
Не понятно, зачем сохранять, да и ещё как XLSTART\PERSONAL.XLSB?
И самое главное выкинули - где выгрузка полученного массива?
ааа
Может быть я не правильно...
Я когда занёс код в vb,потом нажал на компиляцию,а затем его сохранил.
как раз в этом пути и лежит этот бинарный файл.
Удалить его?
Я запутался,что зделать с Вашим кодом?
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 20:54   #13
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Я тот код тестил на Ваших больших таблицах - нормально отработал.
Чуть позже гляну на изменённой.
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 20:55   #14
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Что сделать - положить в модуль чистого файла.
Вот приложение - запускаете его, потом свой файл.
На активном своём файле по Alt+F8 выбираете макрос Otbor, запускаете.
В этом приложенном файле на первом листе получаете выборку.
Сделать в два столбца, как Вы хотите - не так просто. Просто, если гарантированно будут пары, т.е. если можно тупо разложить нечётные в первый столбик, чётные во второй. Но так может и не быть... Надо думать... но как-то не думается уже.
Может и так хорошо будет?
Вложения
Тип файла: zip Otbor.zip (7.7 Кб, 11 просмотров)
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 15.03.2011 в 21:05.
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 21:04   #15
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Я так не пойму.
Я открыл начальную таблицу в экселе,далее открыл вкладку Разработчик,
далее нужно открыть вижуал бэйсик или макросы?
Открываю вижуал,у меня уже находится в редакторе вот этот код:
Код:
Option Explicit
Sub Viborka_hc()
'
' Viborka_hc Макрос
' Выбирает и суммирует значения показателей гор и хол воды
'
    Dim a(), b, cc, oDict As Object, i As Long, ii As Long, j As Long, k As Long, temp As String

    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
'
' Application.Run "PERSONAL.XLSB!Viborka_hc"
End Sub
Имя функции изменил,так как изначально когда создавал имя макросу,то Эксел ассоциирует сразу и с кодом.
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 21:11   #16
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

То, что он в редакторе - это полдела. Нужно знать, в каком файле, в листе или модуле... Да и в этом коде нет выгрузки.
В принципе, этот код может быть и в Personal.xlsb, и название процедуры не важно.
Если сюда добавить выгрузку в нужный файл - всё отработает.
А выгрузку нужно делать не в ThisWorkbook.Worksheets(1), как у меня, а или в анализируемый файл в чистый лист (что там может и не быть), или лучше в новую книгу.
Т.е. окончание тогда такое:
вместо
Код:
'
' Application.Run "PERSONAL.XLSB!Viborka_hc"
End Sub
нужно
Код:
    With Workbooks.Add.Worksheets(1)
        .Range("A1:C1").Resize(j) = b
    End With

End Sub
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 15.03.2011 в 21:14.
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 21:20   #17
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Всё.Результат есть!Щас сравню.
Код формирует выгрузку как бы новую книгу,да?

Как я понял, по подобию представленной в аттаче таблице не сделать?
Два столбца не сформировть для значений x и г?

Последний раз редактировалось igsxor; 15.03.2011 в 21:25.
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 21:22   #18
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Да, результат в новой книге. Её можете сохранить, а можете скопировать данные куда угодно.
Чтоб разложить суммы в два столбца - нужно полученный массив до выгрузки переложить в другой. Как правильно сделать - пока не вижу, и вероятно сегодня не придумаю... Я не против, чтоб кто другой придумал
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 15.03.2011 в 23:33.
Hugo121 вне форума Ответить с цитированием
Старый 15.03.2011, 21:38   #19
igsxor
Пользователь
 
Регистрация: 15.03.2011
Сообщений: 35
По умолчанию

Цитата:
Сообщение от Hugo121 Посмотреть сообщение
Да.
Чтоб разложить суммы в два столбца - нужно полученный массив до выгрузки переложить в другой. Как правильно сделать - пока не вижу, и вероятно сегодня не придумаю... Я не против, чтоб кто другой придумал
Спасибо=)
Перечислю завтра немного денег.
igsxor вне форума Ответить с цитированием
Старый 15.03.2011, 22:11   #20
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Можно сделать так - собрать уникальные полученного массива в другой словарь и потом с помощью этого словаря перебрать массив "b" в массив "c" в нужном порядке.

Получилось. Там ещё (как оказалось ) много лишних переменных было от предыдущей версии...
Код:
Option Explicit

Sub Otbor()
    Dim a(), b, c, i As Long, j As Long, jj As Long, k As Long, temp As String

    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 Workbooks.Add.Worksheets(1)
        .[A1] = "numls": [B1] = "итог по Х": [D1] = "итог по Г"
        .Range("A2:D2").Resize(jj) = c
        .UsedRange.EntireColumn.AutoFit
    End With

End Sub
Код в файле. Комментарии писать лениво... Если где непонятно - спрашивайте.
Вложения
Тип файла: zip Otbor.v02.zip (9.4 Кб, 12 просмотров)
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 15.03.2011 в 23:41.
Hugo121 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос группировки данных в таблице magana Microsoft Office Excel 1 28.01.2011 23:52
Обновление данных из табл в др. Ал3 Microsoft Office Access 1 04.07.2010 00:27
Результат перевода из 10й сис-мы в 16-ю занести в табл(10-е число - 16), до тех пор пока не будет введено Maemi_IT Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 1 11.01.2010 21:27
Кол-во данных в таблице dani92 БД в Delphi 1 02.04.2009 07:58
Как выпонить действия по двойному слику на созданной таблице Tiolic Общие вопросы Delphi 2 21.06.2007 09:53