Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создание массива по критерию с выборкой из него по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание массива по критерию с выборкой из него по условию (Макросы/Sub)
Создание массива по критерию с выборкой из него по условию
Mutarix Дата: Четверг, 20.12.2018, 12:11 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Добрый день, Друзья

Макрос ниже даёт следующий результат:



То есть находит "дату отправки на согласования" и "дату согласования" последнюю в ряде событий.

[vba]
Код

Sub dс()
Dim dic As Object
Dim ShtK As Worksheet

    Application.ScreenUpdating = False 'отключаем обновление экрана
    Application.Calculation = xlCalculationManual 'отключаем автоматический пересчёт формул после каждого действия с листом
    Application.EnableEvents = False 'отключаем отслеживание событий

Set ShtK = Workbooks("Согласование заказа в 1С.xlsm").Worksheets("TDSheet")
ShtK.Range("F2:I100000").ClearContents 'очищаем поля перед вставкой новых значений

Set dic = CreateObject("Scripting.Dictionary")

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 3).Value = "На согласовании" Or Cells(i, 3).Value = "Отклонен" Or Cells(i, 3).Value = "Ошибка обмена" Or Cells(i, 3).Value = "Ожидание синхронизации" Or Cells(i, 3).Value = "Отменен" Then
        ky = Cells(i, 2).Value
        it = Cells(i, 1).Value & "|" & Cells(i, 3).Value
        If dic.exists(ky) Then dic.Item(ky) = it Else dic.Add ky, it
    End If
Next
On Error Resume Next
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 3).Value = "Согласован" Or Cells(i, 3).Value = "Не требует согласования" Then
        ky = Cells(i, 2).Value
        s = Split(dic.Item(ky), "|")
        dic.Item(ky) = s(LBound(s)) & "|" & Cells(i, 1).Value
    End If
Next
i = 2
For Each ky In dic.keys
    s = Split(dic.Item(ky), "|")
    Range("G" & i) = ky
    Range("H" & i) = s(LBound(s))
    Range("I" & i) = s(UBound(s))
    Range("F" & i) = Mid(ky, 18, 16)
    i = i + 1
Next

    Application.ScreenUpdating = True 'включаем обновление экрана
    Application.Calculation = xlCalculationAutomatic 'включаем автоматический пересчёт формул после каждого действия с листом
    Application.EnableEvents = True 'включаем отслеживание событий
         
End Sub

[/vba]

Помогите преобразовать код, что бы результатом было первое событие, то есть первая дата отправки на согласование и первая дата согласования.



Ещё один небольшой комментарий, при работе с большим объёмом данных больше 300 000 строк макрос подвисает. Возможно есть какой то лучше способ чем использовать On Error Resume Next

Заранее спасибо
К сообщению приложен файл: 5180084.xlsm (23.5 Kb)


Сообщение отредактировал Mutarix - Четверг, 20.12.2018, 12:16
 
Ответить
СообщениеДобрый день, Друзья

Макрос ниже даёт следующий результат:



То есть находит "дату отправки на согласования" и "дату согласования" последнюю в ряде событий.

[vba]
Код

Sub dс()
Dim dic As Object
Dim ShtK As Worksheet

    Application.ScreenUpdating = False 'отключаем обновление экрана
    Application.Calculation = xlCalculationManual 'отключаем автоматический пересчёт формул после каждого действия с листом
    Application.EnableEvents = False 'отключаем отслеживание событий

Set ShtK = Workbooks("Согласование заказа в 1С.xlsm").Worksheets("TDSheet")
ShtK.Range("F2:I100000").ClearContents 'очищаем поля перед вставкой новых значений

Set dic = CreateObject("Scripting.Dictionary")

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 3).Value = "На согласовании" Or Cells(i, 3).Value = "Отклонен" Or Cells(i, 3).Value = "Ошибка обмена" Or Cells(i, 3).Value = "Ожидание синхронизации" Or Cells(i, 3).Value = "Отменен" Then
        ky = Cells(i, 2).Value
        it = Cells(i, 1).Value & "|" & Cells(i, 3).Value
        If dic.exists(ky) Then dic.Item(ky) = it Else dic.Add ky, it
    End If
Next
On Error Resume Next
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 3).Value = "Согласован" Or Cells(i, 3).Value = "Не требует согласования" Then
        ky = Cells(i, 2).Value
        s = Split(dic.Item(ky), "|")
        dic.Item(ky) = s(LBound(s)) & "|" & Cells(i, 1).Value
    End If
Next
i = 2
For Each ky In dic.keys
    s = Split(dic.Item(ky), "|")
    Range("G" & i) = ky
    Range("H" & i) = s(LBound(s))
    Range("I" & i) = s(UBound(s))
    Range("F" & i) = Mid(ky, 18, 16)
    i = i + 1
Next

    Application.ScreenUpdating = True 'включаем обновление экрана
    Application.Calculation = xlCalculationAutomatic 'включаем автоматический пересчёт формул после каждого действия с листом
    Application.EnableEvents = True 'включаем отслеживание событий
         
End Sub

[/vba]

Помогите преобразовать код, что бы результатом было первое событие, то есть первая дата отправки на согласование и первая дата согласования.



Ещё один небольшой комментарий, при работе с большим объёмом данных больше 300 000 строк макрос подвисает. Возможно есть какой то лучше способ чем использовать On Error Resume Next

Заранее спасибо

Автор - Mutarix
Дата добавления - 20.12.2018 в 12:11
sboy Дата: Четверг, 20.12.2018, 14:23 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Вариант на Power Query (в запросе необходимо изменить источник данных на Ваш файл с выгрузкой)
К сообщению приложен файл: PQ_1C.xlsx (20.5 Kb) · 1701081.jpg (24.9 Kb)


Яндекс: 410016850021169

Сообщение отредактировал sboy - Четверг, 20.12.2018, 14:24
 
Ответить
СообщениеДобрый день.
Вариант на Power Query (в запросе необходимо изменить источник данных на Ваш файл с выгрузкой)

Автор - sboy
Дата добавления - 20.12.2018 в 14:23
Mutarix Дата: Четверг, 20.12.2018, 15:01 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
sboy, всё бы хорошо но у меня 2010 версия Excel, вариант PQ не подходит
 
Ответить
Сообщениеsboy, всё бы хорошо но у меня 2010 версия Excel, вариант PQ не подходит

Автор - Mutarix
Дата добавления - 20.12.2018 в 15:01
sboy Дата: Четверг, 20.12.2018, 15:20 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
но у меня 2010 версия Excel

у меня тоже :)
качайте бесплатно надстройку на сайте Microsoft


Яндекс: 410016850021169
 
Ответить
Сообщение
но у меня 2010 версия Excel

у меня тоже :)
качайте бесплатно надстройку на сайте Microsoft

Автор - sboy
Дата добавления - 20.12.2018 в 15:20
Mutarix Дата: Четверг, 20.12.2018, 15:41 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
sboy, у меня ограничения, по установке доп. ПО, компьютер рабочий.
В принципе код работает и в результате даёт максимальное значение, но нужно из массива как то достать минимальные значения.
 
Ответить
Сообщениеsboy, у меня ограничения, по установке доп. ПО, компьютер рабочий.
В принципе код работает и в результате даёт максимальное значение, но нужно из массива как то достать минимальные значения.

Автор - Mutarix
Дата добавления - 20.12.2018 в 15:41
_Boroda_ Дата: Четверг, 20.12.2018, 15:49 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Может обычной сводной подойдет?

*Поправил там немного. см. файл _1
К сообщению приложен файл: 456256846.xlsm (14.2 Kb) · 456256846_1.xlsm (14.5 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995


Сообщение отредактировал _Boroda_ - Четверг, 20.12.2018, 15:56
 
Ответить
СообщениеМожет обычной сводной подойдет?

*Поправил там немного. см. файл _1

Автор - _Boroda_
Дата добавления - 20.12.2018 в 15:49
Mutarix Дата: Четверг, 20.12.2018, 17:26 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
А как у вас получилось в сводной таблице значения в виде даты.
У меня в таблице значение 01,01,1900 прикрепил файл
К сообщению приложен файл: 4095964.xlsm (15.7 Kb)
 
Ответить
СообщениеА как у вас получилось в сводной таблице значения в виде даты.
У меня в таблице значение 01,01,1900 прикрепил файл

Автор - Mutarix
Дата добавления - 20.12.2018 в 17:26
Mutarix Дата: Пятница, 21.12.2018, 17:10 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Друзья есть идеи как откорректировать мой макрос?
 
Ответить
СообщениеДрузья есть идеи как откорректировать мой макрос?

Автор - Mutarix
Дата добавления - 21.12.2018 в 17:10
Pelena Дата: Пятница, 21.12.2018, 19:43 | Сообщение № 9
Группа: Админы
Ранг: Местный житель
Сообщений: 19162
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Посмотрите вариант, если правильно поняла
К сообщению приложен файл: 7653004.xlsm (23.1 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеПосмотрите вариант, если правильно поняла

Автор - Pelena
Дата добавления - 21.12.2018 в 19:43
Hugo Дата: Пятница, 21.12.2018, 20:17 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3250
Репутация: 707 ±
Замечаний: 0% ±

2019
при работе с большим объёмом данных больше 300 000 строк макрос подвисает. Возможно есть какой то лучше способ чем использовать On Error Resume Next
- конечно. Не обращаться к ячейкам индивидуально.
Вот например зачем на каждом шаге ШЕСТЬ раз лезете в ячейку Cells(i, 3)? Достаточно одного обращения, и не к ячейке, а к элементу массива данных.


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Пятница, 21.12.2018, 20:20
 
Ответить
Сообщение
при работе с большим объёмом данных больше 300 000 строк макрос подвисает. Возможно есть какой то лучше способ чем использовать On Error Resume Next
- конечно. Не обращаться к ячейкам индивидуально.
Вот например зачем на каждом шаге ШЕСТЬ раз лезете в ячейку Cells(i, 3)? Достаточно одного обращения, и не к ячейке, а к элементу массива данных.

Автор - Hugo
Дата добавления - 21.12.2018 в 20:17
Mutarix Дата: Пятница, 25.01.2019, 17:30 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Hugo, ваше замечание существенно, но мне реализовать не удаётся. Можете показать как изменить код с учётом ваших рекомендаций.
 
Ответить
СообщениеHugo, ваше замечание существенно, но мне реализовать не удаётся. Можете показать как изменить код с учётом ваших рекомендаций.

Автор - Mutarix
Дата добавления - 25.01.2019 в 17:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание массива по критерию с выборкой из него по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!