Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Суммирование данных по условию макросом
 
#1
22.04.2016 11:02:17
Здравствуйте! Подскажите пожалуйста как обработать следующий запрос макросом:

Есть лист с данными (лист2) - общее количество строк изменяется (до 1500 и более)
порядок столбцов постоянный
лист(1) - форма куда собирается информация
при этом формат листа тоже постоянный (в примере я оставила только значимые поля)

требуется собрать в форму на листе 1 данные с листа 2 при выполнении условия совпадения кода статьи и номера проекта
при этом данные на листе 2  с одинаковыми параметрами могут быть внесены несколькими записями (их нужно сложить)

нарисовала вот такой макрос (все ссылки на реальные диапазоны) :
Код
Sub Макрос12() 
Dim CompareRange As Variant, x As Variant, y As Variant, g As Variant, z As Variant
Dim k As Variant, l As Variant
  z = 0
  z1 = 0
  k = 0
  g = 0
Set CompareRange = Worksheets("Лист1").Range("b15:b700")
Worksheets("Лист2").Activate
Worksheets("Лист2").Range("b3:b1125").Select
 For Each y In CompareRange
 For g = 1 To 15
  k = 1
 If g Mod 4 = 0 Then g = g + 1
       For Each x In Selection
        If x = y Then
        If y <> 0 Then
         If x.Offset(0, -1) = 10100 Then
           z = x.Offset(0, 3 + k)
           z1 = z1 + z
           y.Offset(0, 4 + g) = z1 
                End If
                End If
                End If
           Next x
         z = 0
         z1 = 0
       Next g
       k = k + 1
      Next y
 Worksheets("Лист1").Activate
  End Sub
но он очень медленный, если есть другое решение,
то Большое Вам спасибо!
Изменено: Marlin - 25.04.2016 20:19:56
 
 
 
#2
22.04.2016 11:11:27
Посмотрите здесь
 
 
 
#3
22.04.2016 20:31:16
Marlin, код слепдует оформлять соответствующим тегом. Ищите такую кнопку <...> и исправьте своё сообщение.
Спасибо!
 
 
 
#4
25.04.2016 10:47:34
LVL, спасибо Вам за ссылку, но к сожалению не получилось у меня под свои нужды код приспособитьэтот вот кусочек, в форме с итогом данные заносятся в 3 столбец
Код
vaTotalData(n, 3) = vaTotalData(n, 3) + Abs(vaBasicData(i, 7) + vaBasicData(i, 6))
мне нужно записать сумму не в один столбец а в 12 последовательно... здесь нужен еще один цикл для столбца? и как мне потом данные в форму с итогами вывести
Спасибо
 
 
 
#5
25.04.2016 11:09:01
Цитата
при выполнении условия совпадения кода статьи и номера проекта
А где на Лист1 собираются данные для кода проекта 10200 ?
 
 
 
#6
25.04.2016 11:13:11
Дело в том, что  данные по проектам собираются на разных листах, мне бы для начала по одному условию определиться. Эту задачу я могу решить и формулами, но хотелось бы обезопасить свои расчеты от случайных ошибок
Изменено: Marlin - 25.04.2016 11:16:54
 
 
 
#7
25.04.2016 11:51:00
Макрос в модуль Лист1, срабатывает при активации данного листа
Код
Private Sub Worksheet_Activate()
Dim iKod As String
Dim KodProect As String
Dim FoundKod As Range
Dim i As Long
Dim iLastRow As Long
Dim FirstKod As String

Application.ScreenUpdating = False
  iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Range("F6:H" & iLastRow).ClearContents
    Range("J6:L" & iLastRow).ClearContents
    Range("N6:P" & iLastRow).ClearContents
    Range("R6:T" & iLastRow).ClearContents
    
      KodProect = Range("E3")
    For i = 6 To iLastRow
            iKod = Cells(i, 2)
        With Sheets("Лист2")
                Set FoundKod = .Columns(2).Find(iKod, , xlValues, xlWhole)
         If Not FoundKod Is Nothing Then
                FirstKod = FoundKod.Address  'адрес первого вхождения кода в столбце В
            Do
              If .Cells(FoundKod.Row, 1) = KodProect Then
                Cells(i, 6) = Cells(i, 6) + .Cells(FoundKod.Row, 5) 'январь
                Cells(i, 7) = Cells(i, 7) + .Cells(FoundKod.Row, 6) 'февраль
                'для остальных месяцв аналогично
                
              End If
            Set FoundKod = .Columns(2).FindNext(FoundKod)
            Loop While FoundKod.Address <> FirstKod
         End If
        End With
   Next
Application.ScreenUpdating = True
End Sub
 
 
 
#8
25.04.2016 15:27:29
Kuzmich, спасибо Вам за помощь, но на реальной моей базе этот код работает так же очень медленно ... (
 
 
 
#9
25.04.2016 15:39:06
Цитата
на реальной моей базе этот код работает так же очень медленно
Сколько строк в реальной базе?
 
 
 
#10
25.04.2016 15:41:10
700 уникальных значений с кодами статей..  выборку делаем из 1500 строк с данными ( ну это как мин.)
 
 
 
#11
25.04.2016 15:42:12
Пришлите реальную базу
 
 
 
#12
25.04.2016 16:07:48
Файл с Вашим кодом,
 
 
 
#13
25.04.2016 17:21:43
Разве это долго считает? Я успел сказать раз-два, а уже все данные подтянуты.
 
 
 
#14
25.04.2016 18:43:17
Kuzmich, спасибо!!! стоило принести ноут с работы домой и все летает. вдимо что то тормозило  :D СПАСИБО!! выручили  
 
 
 
#15
25.04.2016 19:07:50
Цикл по листам сами сделаете?(для 10100, 10200 и т.д.)
 
 
 
#16
25.04.2016 23:03:32
так как у меня данные по проектам на отдельных листах я сделала так:
Код
dd = ActiveSheet.Range("n2")' на листе с данными по проекту имя листа откуда выборку делаем, он общий для всех
  
 With Sheets(dd) ' обращение к этому листу
получается для каждого проекта нужно макрос перезапускать

или лучше все же сделать цикл по листам?
 
 
 
#17
25.04.2016 23:43:26
На Лист2 можно сделать кнопочку, к которой привязать макрос.
Макрос циклом пробегает по листам и подтягивает данные с Лист2
на лист соответствующего проекта.
Скрытый текст
Изменено: Kuzmich - 25.04.2016 23:46:33
 
 
 
#18
25.04.2016 23:54:00
Про такой цикл
Код
For Each Sht In Worksheets
  If Sht.Name <> "Лист2" Then        ' кроме листа "Лист2"
    With Sht
я тоже думала, но у меня в этой книге не только листы с одинаковым форматом, есть еще сводные консолидированные формы
и поэтому ссылку на  обрабатываемые листы  нужно по имени делать или отдельным списком где то их указывать
 
 
 
#19
25.04.2016 23:59:36
Исключите листы, добавив их в строке
Код
 If Sht.Name <> "Лист2" Then        ' кроме листа "Лист2"
 
 
 
Страницы: 1
Наверх