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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос по подсчету уникальных значений - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по подсчету уникальных значений (Макросы/Sub)
Макрос по подсчету уникальных значений
drblasster88 Дата: Суббота, 16.01.2016, 15:21 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Доброго времени суток! Дамы и господа, нужна помощь в составлении макроса для сбора отчетности. Если кто-то сможет помочь - буду очень благодарен.
Прикладываю 2 файла. В первом файле выгрузка данных из программы, она всегда будет одного формата, но с разным количеством значений, во втором файле отчетная форма в которую нужно вывести количественные значения по собранным данным:
-В первом файле в столбце А ищем запись "Решение о приостановлении операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку С3
-В первом файле в столбце А ищем запись "Решение об отмене приостановления операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку F3
-В первом файле в столбце С ищем уникальные записи по маске "BOS1_RPO" и "BOS1_RBN" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку D3
-В первом файле в столбце С ищем уникальные записи по маске "PB2_RPO" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку E3
- В первом файле в столбце B ищем уникальные значения по маске "29000112" и "29000117" считаем только те, напротив которых в столбце не стоят значения "BOS1_RPO", "PB2_RPO" и "BOS1_RBN", т.е. пустые поля, результат выводим в таблицу в ячейку I3
К сообщению приложен файл: 3592029.xlsm(13Kb)
 
Ответить
СообщениеДоброго времени суток! Дамы и господа, нужна помощь в составлении макроса для сбора отчетности. Если кто-то сможет помочь - буду очень благодарен.
Прикладываю 2 файла. В первом файле выгрузка данных из программы, она всегда будет одного формата, но с разным количеством значений, во втором файле отчетная форма в которую нужно вывести количественные значения по собранным данным:
-В первом файле в столбце А ищем запись "Решение о приостановлении операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку С3
-В первом файле в столбце А ищем запись "Решение об отмене приостановления операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку F3
-В первом файле в столбце С ищем уникальные записи по маске "BOS1_RPO" и "BOS1_RBN" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку D3
-В первом файле в столбце С ищем уникальные записи по маске "PB2_RPO" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку E3
- В первом файле в столбце B ищем уникальные значения по маске "29000112" и "29000117" считаем только те, напротив которых в столбце не стоят значения "BOS1_RPO", "PB2_RPO" и "BOS1_RBN", т.е. пустые поля, результат выводим в таблицу в ячейку I3

Автор - drblasster88
Дата добавления - 16.01.2016 в 15:21
drblasster88 Дата: Суббота, 16.01.2016, 15:31 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Вот файл выгрузки
К сообщению приложен файл: 1436148.xlsm(98Kb)
 
Ответить
СообщениеВот файл выгрузки

Автор - drblasster88
Дата добавления - 16.01.2016 в 15:31
Manyasha Дата: Воскресенье, 17.01.2016, 00:49 | Сообщение № 3
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
drblasster88, проверяйте (макрос запускается из файла отчет)
[vba]
Код
Sub report()
    Application.ScreenUpdating = False
    Dim f As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Please select a file": .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Excel", "*.xls;*.xlsx;*.xlsm;*.xlsb", 1: .AllowMultiSelect = False
        If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub
        f = .SelectedItems(1)
    End With
    Set shRep = ThisWorkbook.Sheets(1)
    Set openWb = Workbooks.Open(f)
    Set shData = openWb.Sheets(1)
    shRep.Range("c3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение о приостановлении операций по счетам (НО)")
    shRep.Range("f3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение об отмене приостановления операций по счетам (НО)")
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    Set d3 = CreateObject("Scripting.Dictionary")
    Dim dataBC
    dataBC = shData.[b1].Resize(shData.UsedRange.Rows.Count, 2)
    For i = 1 To UBound(dataBC)
        If InStr(dataBC(i, 2), "BOS1_RPO") Or InStr(dataBC(i, 2), "BOS1_RBN") Then
            If d1.Exists(dataBC(i, 2)) = False Then d1.Item(dataBC(i, 2)) = i
        ElseIf InStr(dataBC(i, 2), "PB2_RPO") Then
            If d2.Exists(dataBC(i, 2)) = False Then d2.Item(dataBC(i, 2)) = i
        End If
        If (InStr(dataBC(i, 1), "29000112") Or InStr(dataBC(i, 1), "29000117")) _
            And Trim(dataBC(i, 2)) = "" Then
            If d3.Exists(dataBC(i, 2)) = False Then d3.Item(dataBC(i, 2)) = i
        End If
    Next i
    shRep.Range("d3") = d1.Count
    shRep.Range("e3") = d2.Count
    shRep.Range("i3") = d3.Count
    openWb.Close
    Application.ScreenUpdating = True
End Sub
[/vba]
[p.s.]Выгрузку в xlsb сохранила, чтобы влезло в 100кб[/p.s.]
К сообщению приложен файл: 20160117-drblas.rar(65Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеdrblasster88, проверяйте (макрос запускается из файла отчет)
[vba]
Код
Sub report()
    Application.ScreenUpdating = False
    Dim f As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Please select a file": .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Excel", "*.xls;*.xlsx;*.xlsm;*.xlsb", 1: .AllowMultiSelect = False
        If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub
        f = .SelectedItems(1)
    End With
    Set shRep = ThisWorkbook.Sheets(1)
    Set openWb = Workbooks.Open(f)
    Set shData = openWb.Sheets(1)
    shRep.Range("c3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение о приостановлении операций по счетам (НО)")
    shRep.Range("f3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение об отмене приостановления операций по счетам (НО)")
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    Set d3 = CreateObject("Scripting.Dictionary")
    Dim dataBC
    dataBC = shData.[b1].Resize(shData.UsedRange.Rows.Count, 2)
    For i = 1 To UBound(dataBC)
        If InStr(dataBC(i, 2), "BOS1_RPO") Or InStr(dataBC(i, 2), "BOS1_RBN") Then
            If d1.Exists(dataBC(i, 2)) = False Then d1.Item(dataBC(i, 2)) = i
        ElseIf InStr(dataBC(i, 2), "PB2_RPO") Then
            If d2.Exists(dataBC(i, 2)) = False Then d2.Item(dataBC(i, 2)) = i
        End If
        If (InStr(dataBC(i, 1), "29000112") Or InStr(dataBC(i, 1), "29000117")) _
            And Trim(dataBC(i, 2)) = "" Then
            If d3.Exists(dataBC(i, 2)) = False Then d3.Item(dataBC(i, 2)) = i
        End If
    Next i
    shRep.Range("d3") = d1.Count
    shRep.Range("e3") = d2.Count
    shRep.Range("i3") = d3.Count
    openWb.Close
    Application.ScreenUpdating = True
End Sub
[/vba]
[p.s.]Выгрузку в xlsb сохранила, чтобы влезло в 100кб[/p.s.]

Автор - Manyasha
Дата добавления - 17.01.2016 в 00:49
drblasster88 Дата: Воскресенье, 17.01.2016, 05:14 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Здравствуйте.

Спасибо Вам огромное!!! Очень выручили! Но есть два вопроса:
В первом файле в столбце B ищем уникальные значения по маске "29000112" и "29000117" считаем только те, напротив которых в столбце не стоят значения "BOS1_RPO", "PB2_RPO" и "BOS1_RBN", т.е. пустые поля, результат выводим в таблицу в ячейку I3
По выше указанному условию я вижу в вашем макросе, что вы задали параметр пусто And Trim(dataBC(i, 2)) = "" Then
Но по какой то причине в отчете постоянно стоит "1". Насколько я понял это происходит из за того что для "29000117" кроме вариантов "BOS1_RPO", "PB2_RPO" и "BOS1_RBN" есть еще вариант "Статус: Исполнено". По логике он должен в отчет выводить только количество тех экземпляров "29000117" у которых (i, 2)) = "". Причем в полной выгрузке(я вам предоставлял только ее часть из за большого объема файла) таких экземпляров больше чем один, но в отчете все равно единица. Не подскажете что нужно поменять в коде, что бы в ячейку I3 не выводилось количество экземпляров по "29000117" у которых (i, 2)) = ""???
Так же не совсем понял как получилось что количество "BOS1_RPO" + "BOS1_RBN" больше чем количество "Решение о приостановлении операций по счетам (НО)"), они должны быть равны или меньше. (Это тоже видно по отчету из полной выгрузки)Надеюсь вы не против если я вам на marinamorozova_box@mail.ru его пришлю?
 
Ответить
СообщениеЗдравствуйте.

Спасибо Вам огромное!!! Очень выручили! Но есть два вопроса:
В первом файле в столбце B ищем уникальные значения по маске "29000112" и "29000117" считаем только те, напротив которых в столбце не стоят значения "BOS1_RPO", "PB2_RPO" и "BOS1_RBN", т.е. пустые поля, результат выводим в таблицу в ячейку I3
По выше указанному условию я вижу в вашем макросе, что вы задали параметр пусто And Trim(dataBC(i, 2)) = "" Then
Но по какой то причине в отчете постоянно стоит "1". Насколько я понял это происходит из за того что для "29000117" кроме вариантов "BOS1_RPO", "PB2_RPO" и "BOS1_RBN" есть еще вариант "Статус: Исполнено". По логике он должен в отчет выводить только количество тех экземпляров "29000117" у которых (i, 2)) = "". Причем в полной выгрузке(я вам предоставлял только ее часть из за большого объема файла) таких экземпляров больше чем один, но в отчете все равно единица. Не подскажете что нужно поменять в коде, что бы в ячейку I3 не выводилось количество экземпляров по "29000117" у которых (i, 2)) = ""???
Так же не совсем понял как получилось что количество "BOS1_RPO" + "BOS1_RBN" больше чем количество "Решение о приостановлении операций по счетам (НО)"), они должны быть равны или меньше. (Это тоже видно по отчету из полной выгрузки)Надеюсь вы не против если я вам на marinamorozova_box@mail.ru его пришлю?

Автор - drblasster88
Дата добавления - 17.01.2016 в 05:14
Manyasha Дата: Воскресенье, 17.01.2016, 15:06 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
drblasster88,
вы не против если

не по Правилам это!
Решать вопросы вне темы разрешается только в разделе Работа/Фриланс.
Либо выкладывайте новый файл сюда, либо просите перенести тему.

По Вашим вопросам (файлы из моего поста):
1. Для строк со значениями "29000112" и "29000117" получается 1, т.к. в Выгрузке есть 1 такая строчка. Там объединенные ячейки, и фактически "Статус: Исполнено" стоит на строчку выше, а в текущей и правда пусто (строчку желтым выделила) :)
Правильно ли я понимаю, что должно быть не 1, а ноль? Т.е в 3-м столбце по текущему счету везде пусто? См. новый файл, код поправила.

По второму пункту:
количество "BOS1_RPO" + "BOS1_RBN" больше чем количество "Решение о приостановлении операций по счетам (НО)"
Не нашла такого...количество "BOS1_RPO" + "BOS1_RBN" = 102, "Решение о приостановлении..." = 105.
Это тоже видно по отчету из полной выгрузки

Покажите кусок, где не правильно считается.
UPD Файл забыла прикрепить!
К сообщению приложен файл: 6314099.rar(67Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804


Сообщение отредактировал Manyasha - Воскресенье, 17.01.2016, 15:43
 
Ответить
Сообщениеdrblasster88,
вы не против если

не по Правилам это!
Решать вопросы вне темы разрешается только в разделе Работа/Фриланс.
Либо выкладывайте новый файл сюда, либо просите перенести тему.

По Вашим вопросам (файлы из моего поста):
1. Для строк со значениями "29000112" и "29000117" получается 1, т.к. в Выгрузке есть 1 такая строчка. Там объединенные ячейки, и фактически "Статус: Исполнено" стоит на строчку выше, а в текущей и правда пусто (строчку желтым выделила) :)
Правильно ли я понимаю, что должно быть не 1, а ноль? Т.е в 3-м столбце по текущему счету везде пусто? См. новый файл, код поправила.

По второму пункту:
количество "BOS1_RPO" + "BOS1_RBN" больше чем количество "Решение о приостановлении операций по счетам (НО)"
Не нашла такого...количество "BOS1_RPO" + "BOS1_RBN" = 102, "Решение о приостановлении..." = 105.
Это тоже видно по отчету из полной выгрузки

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

Автор - Manyasha
Дата добавления - 17.01.2016 в 15:06
Manyasha Дата: Воскресенье, 17.01.2016, 16:01 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
Кстати, посмотрите примечания в файле отчет. Может я не правильно поняла, что куда вносить?...


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеКстати, посмотрите примечания в файле отчет. Может я не правильно поняла, что куда вносить?...

Автор - Manyasha
Дата добавления - 17.01.2016 в 16:01
drblasster88 Дата: Воскресенье, 17.01.2016, 16:35 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Уменьшил выгрузку до допустимого объема. Давайте с ней поработаем. Вы все правильно поняли. Данные вставляются куда нужно.
Вот что у меня сейчас
Общая загрузка Приостановления Отмены Не отправлено Справок по приостановлениям
Всего Справка Отказ Всего
ВВБ 164 162 3 9 1

По поводу разности значений в столбце Всего и сумме столбцов Справка и отказ, кажется понял. В Файле причина в самом конце: Там для одного "Решения о приостановлении" два типа ответа "BOS1" и "PB2" из за этого сумма "BOS1" и "PB2" получается больше чем сумма "Решения о приостановлении". Думаю с этим наверно мы ничего не сможем сделать...

А вот по поводу столбца "Не отправлено Справок по приостановлениям" можно ли сделать что-нибудь с объединенной ячейкой? потому что во всех ответах она будет объединена и находиться на той же позиции, различие будет только в том что по 2900012 она будет полностью пустая, а по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен. В выгрузке сделал оба варианта, для удобства я все проблемные варианты поместил внизу, начинайте смотреть после ячейки 2313
К сообщению приложен файл: 7898210.xlsm(0Kb)
 
Ответить
СообщениеУменьшил выгрузку до допустимого объема. Давайте с ней поработаем. Вы все правильно поняли. Данные вставляются куда нужно.
Вот что у меня сейчас
Общая загрузка Приостановления Отмены Не отправлено Справок по приостановлениям
Всего Справка Отказ Всего
ВВБ 164 162 3 9 1

По поводу разности значений в столбце Всего и сумме столбцов Справка и отказ, кажется понял. В Файле причина в самом конце: Там для одного "Решения о приостановлении" два типа ответа "BOS1" и "PB2" из за этого сумма "BOS1" и "PB2" получается больше чем сумма "Решения о приостановлении". Думаю с этим наверно мы ничего не сможем сделать...

А вот по поводу столбца "Не отправлено Справок по приостановлениям" можно ли сделать что-нибудь с объединенной ячейкой? потому что во всех ответах она будет объединена и находиться на той же позиции, различие будет только в том что по 2900012 она будет полностью пустая, а по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен. В выгрузке сделал оба варианта, для удобства я все проблемные варианты поместил внизу, начинайте смотреть после ячейки 2313

Автор - drblasster88
Дата добавления - 17.01.2016 в 16:35
Manyasha Дата: Воскресенье, 17.01.2016, 17:37 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен

дык в последнем моем файле так и есть - попадают в отчет только полностью пустые, Статус исполнено НЕ попадает.

для одного "Решения о приостановлении" два типа ответа
Код
Всего = Справка+Отказ
так должно быть?
Может тогда просто посчитать Всего (С3), Справка (D3), а отказ поставить, как C3-D3?

[p.s.]
К сообщению приложен файл: 7898210.xlsm(0Kb)
Файл не открывается (расширение является не допустимым), сокрее всего из-за того, что Вы расширение вручную поменяли. Да и к тому же вес 0кб[/p.s.]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение
по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен

дык в последнем моем файле так и есть - попадают в отчет только полностью пустые, Статус исполнено НЕ попадает.

для одного "Решения о приостановлении" два типа ответа
Код
Всего = Справка+Отказ
так должно быть?
Может тогда просто посчитать Всего (С3), Справка (D3), а отказ поставить, как C3-D3?

[p.s.]
К сообщению приложен файл: 7898210.xlsm(0Kb)
Файл не открывается (расширение является не допустимым), сокрее всего из-за того, что Вы расширение вручную поменяли. Да и к тому же вес 0кб[/p.s.]

Автор - Manyasha
Дата добавления - 17.01.2016 в 17:37
drblasster88 Дата: Воскресенье, 17.01.2016, 18:23 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен
Я может что то не так делаю но у меня в отчет падают пустые только по 29000112...пустые по 29000117 в отчет не попадают. Скажите, а можно сделать, что бы в отчете в ячейку К3 помещались в строчку через запятую полные наименования файлов 29000112 и 29000117 по которым эти самые пустые ячейки?

А по поводу отказов....Я что то не сообразил сразу....наверно так и сделаю. Спасибо вам огромное
 
Ответить
Сообщениепо 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен
Я может что то не так делаю но у меня в отчет падают пустые только по 29000112...пустые по 29000117 в отчет не попадают. Скажите, а можно сделать, что бы в отчете в ячейку К3 помещались в строчку через запятую полные наименования файлов 29000112 и 29000117 по которым эти самые пустые ячейки?

А по поводу отказов....Я что то не сообразил сразу....наверно так и сделаю. Спасибо вам огромное

Автор - drblasster88
Дата добавления - 17.01.2016 в 18:23
drblasster88 Дата: Воскресенье, 17.01.2016, 19:12 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Точнее после того как макрос находит одну ячейку пустую, он ставит цифру 1 и больше ничего в отчет не выводится...А мне хотелось бы что б он писал количество пустых. Наверно это связано с тем что в ячейку I3 он тоже выводит только уникальные значения? Там нужно что бы было общее количество всех 29000112 и 29000117 с пустыми ячейками
 
Ответить
СообщениеТочнее после того как макрос находит одну ячейку пустую, он ставит цифру 1 и больше ничего в отчет не выводится...А мне хотелось бы что б он писал количество пустых. Наверно это связано с тем что в ячейку I3 он тоже выводит только уникальные значения? Там нужно что бы было общее количество всех 29000112 и 29000117 с пустыми ячейками

Автор - drblasster88
Дата добавления - 17.01.2016 в 19:12
Manyasha Дата: Воскресенье, 17.01.2016, 19:59 | Сообщение № 11
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
drblasster88, нашла ошибку
[vba]
Код
If d3.Exists(dataBC(i, 2)) = False Then d3.Item(dataBC(i, 2)) = i
[/vba]
конечно же там не dataBC(i, 2), а dataBC(i, 1).
нужно что бы было общее количество

там только уникальные, Вы же в 1-м сообщении писали
в столбце B ищем уникальные значения по маске "29000112" и "29000117"
Поправила. Проверяйте новый код. Ненужное для "Не отправлено Справок" потом удалите, я прокомментила все
[vba]
Код
Sub report()
    Application.ScreenUpdating = False
    Dim f As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Please select a file": .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Excel", "*.xls;*.xlsx;*.xlsm;*.xlsb", 1: .AllowMultiSelect = False
        If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub
        f = .SelectedItems(1)
    End With
    Set shRep = ThisWorkbook.Sheets(1)
    Set openWb = Workbooks.Open(f)
    Set shData = openWb.Sheets(1)
    shRep.Range("c3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение о приостановлении операций по счетам (НО)")
    shRep.Range("f3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение об отмене приостановления операций по счетам (НО)")
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d3 = CreateObject("Scripting.Dictionary")
    Dim dataBC
    dataBC = shData.[b1].Resize(shData.UsedRange.Rows.Count, 2)
    For i = 1 To UBound(dataBC)
        If InStr(dataBC(i, 2), "BOS1_RPO") Or InStr(dataBC(i, 2), "BOS1_RBN") Then
            If d1.Exists(dataBC(i, 2)) = False Then d1.Item(dataBC(i, 2)) = i
        End If
        If (InStr(dataBC(i, 1), "29000112") Or InStr(dataBC(i, 1), "29000117")) _
            And Trim(dataBC(i, 2)) = "" Then
            If Trim(dataBC(i - 1, 2)) = "" And Trim(dataBC(i + 1, 2)) = "" Then
                'Считаем уникальные
                If d3.Exists(dataBC(i, 1)) = False Then d3.Item(dataBC(i, 1)) = i
                'Считаем общее кол-во
                k = k + 1
                'Список значений в строчку
                listStr = listStr & dataBC(i, 1) & ", "
            End If
        End If
    Next i
    shRep.Range("d3") = d1.Count
    shRep.Range("e3") = shRep.Range("c3") - shRep.Range("d3")
    'Выводим общее кол-во
    shRep.Range("i3") = k
    'Выводим кол-во уникальных
    shRep.Range("j3") = d3.Count
    'Выводим весь список значений
    shRep.Range("k3") = Mid(listStr, 1, Len(listStr) - 2)
    openWb.Close
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 5297486.xlsm(25Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804


Сообщение отредактировал Manyasha - Воскресенье, 17.01.2016, 20:02
 
Ответить
Сообщениеdrblasster88, нашла ошибку
[vba]
Код
If d3.Exists(dataBC(i, 2)) = False Then d3.Item(dataBC(i, 2)) = i
[/vba]
конечно же там не dataBC(i, 2), а dataBC(i, 1).
нужно что бы было общее количество

там только уникальные, Вы же в 1-м сообщении писали
в столбце B ищем уникальные значения по маске "29000112" и "29000117"
Поправила. Проверяйте новый код. Ненужное для "Не отправлено Справок" потом удалите, я прокомментила все
[vba]
Код
Sub report()
    Application.ScreenUpdating = False
    Dim f As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Please select a file": .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Excel", "*.xls;*.xlsx;*.xlsm;*.xlsb", 1: .AllowMultiSelect = False
        If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub
        f = .SelectedItems(1)
    End With
    Set shRep = ThisWorkbook.Sheets(1)
    Set openWb = Workbooks.Open(f)
    Set shData = openWb.Sheets(1)
    shRep.Range("c3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение о приостановлении операций по счетам (НО)")
    shRep.Range("f3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение об отмене приостановления операций по счетам (НО)")
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d3 = CreateObject("Scripting.Dictionary")
    Dim dataBC
    dataBC = shData.[b1].Resize(shData.UsedRange.Rows.Count, 2)
    For i = 1 To UBound(dataBC)
        If InStr(dataBC(i, 2), "BOS1_RPO") Or InStr(dataBC(i, 2), "BOS1_RBN") Then
            If d1.Exists(dataBC(i, 2)) = False Then d1.Item(dataBC(i, 2)) = i
        End If
        If (InStr(dataBC(i, 1), "29000112") Or InStr(dataBC(i, 1), "29000117")) _
            And Trim(dataBC(i, 2)) = "" Then
            If Trim(dataBC(i - 1, 2)) = "" And Trim(dataBC(i + 1, 2)) = "" Then
                'Считаем уникальные
                If d3.Exists(dataBC(i, 1)) = False Then d3.Item(dataBC(i, 1)) = i
                'Считаем общее кол-во
                k = k + 1
                'Список значений в строчку
                listStr = listStr & dataBC(i, 1) & ", "
            End If
        End If
    Next i
    shRep.Range("d3") = d1.Count
    shRep.Range("e3") = shRep.Range("c3") - shRep.Range("d3")
    'Выводим общее кол-во
    shRep.Range("i3") = k
    'Выводим кол-во уникальных
    shRep.Range("j3") = d3.Count
    'Выводим весь список значений
    shRep.Range("k3") = Mid(listStr, 1, Len(listStr) - 2)
    openWb.Close
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 17.01.2016 в 19:59
drblasster88 Дата: Воскресенье, 17.01.2016, 20:29 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Да, теперь все идеально! Спасибо Вам большое, вы меня очень выручили!!! Ваши реквизиты работоспособны ЯД: 410013299366744 WM: R193491431804?
И последний глупый вопрос: Как мне вывести из выгрузки значение ячейки А8 (там дата выгрузки зашита) в какую-нибудь ячейку отчета?
 
Ответить
СообщениеДа, теперь все идеально! Спасибо Вам большое, вы меня очень выручили!!! Ваши реквизиты работоспособны ЯД: 410013299366744 WM: R193491431804?
И последний глупый вопрос: Как мне вывести из выгрузки значение ячейки А8 (там дата выгрузки зашита) в какую-нибудь ячейку отчета?

Автор - drblasster88
Дата добавления - 17.01.2016 в 20:29
Manyasha Дата: Воскресенье, 17.01.2016, 20:42 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
реквизиты работоспособны
а как же)
для даты добавьте 1 строчку в конец кода:
[vba]
Код
    'Дату выгрузки записываем в А1
    shRep.Range("a1") = shData.Range("a8")
    openWb.Close
    Application.ScreenUpdating = True
End Sub
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение
реквизиты работоспособны
а как же)
для даты добавьте 1 строчку в конец кода:
[vba]
Код
    'Дату выгрузки записываем в А1
    shRep.Range("a1") = shData.Range("a8")
    openWb.Close
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 17.01.2016 в 20:42
drblasster88 Дата: Воскресенье, 17.01.2016, 22:15 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Марин, сможете подсказать как запускать макрос без диалогового окна, что бы не выбирать нужный файлик?
Пытаюсь подставить в код команду...не получается
Workbooks.Open Filename:= _
"C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm"

 
Ответить
СообщениеМарин, сможете подсказать как запускать макрос без диалогового окна, что бы не выбирать нужный файлик?
Пытаюсь подставить в код команду...не получается
Workbooks.Open Filename:= _
"C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm"


Автор - drblasster88
Дата добавления - 17.01.2016 в 22:15
Manyasha Дата: Воскресенье, 17.01.2016, 22:57 | Сообщение № 15
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
drblasster88, вот так попробуйте
[vba]
Код
Set openWb = Workbooks.Open("C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm")
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеdrblasster88, вот так попробуйте
[vba]
Код
Set openWb = Workbooks.Open("C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm")
[/vba]

Автор - Manyasha
Дата добавления - 17.01.2016 в 22:57
drblasster88 Дата: Воскресенье, 17.01.2016, 23:02 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Я так пробовал, ругается на последнюю строку
[vba]
Код
Application.ScreenUpdating = False
Set openWb = Workbooks.Open("C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm")
Set shData = openWb.Sheets(1)
shRep.Range("c3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение о приостановлении операций по счетам (НО)")
[/vba]
[moder]Для кода макроса используйте спецтеги. Кнопка #. Поправил Вам пост.


Сообщение отредактировал _Boroda_ - Понедельник, 18.01.2016, 07:42
 
Ответить
СообщениеЯ так пробовал, ругается на последнюю строку
[vba]
Код
Application.ScreenUpdating = False
Set openWb = Workbooks.Open("C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm")
Set shData = openWb.Sheets(1)
shRep.Range("c3") = WorksheetFunction.CountIf(shData.Columns(1), "Решение о приостановлении операций по счетам (НО)")
[/vba]
[moder]Для кода макроса используйте спецтеги. Кнопка #. Поправил Вам пост.

Автор - drblasster88
Дата добавления - 17.01.2016 в 23:02
Manyasha Дата: Понедельник, 18.01.2016, 10:12 | Сообщение № 17
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
Ну так на последнюю же, а не на метод open.
Показывайте в файле или код целиком.


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеНу так на последнюю же, а не на метод open.
Показывайте в файле или код целиком.

Автор - Manyasha
Дата добавления - 18.01.2016 в 10:12
drblasster88 Дата: Понедельник, 18.01.2016, 21:06 | Сообщение № 18
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Странно, а сегодня получилось....мистика
Но сегодня другая проблема, после того как вы добавили функцию
[vba]
Код
'Выводим весь список значений
shRep.Range("I3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba]
В тех случаях, когда выводить нечего, т.е. поле "не отправлено ответов" остается пустым...макрос начинает ругаться на выше указанную строку...видимо как раз потому что нечего выводить. Можно ли сделать возможным оба варианта исхода событий?
[moder]Повторное нарушение п.3 Правил форума в части тегов. Игнорирование замечаний администрации. Первое замечание.


Сообщение отредактировал _Boroda_ - Понедельник, 18.01.2016, 21:30
 
Ответить
СообщениеСтранно, а сегодня получилось....мистика
Но сегодня другая проблема, после того как вы добавили функцию
[vba]
Код
'Выводим весь список значений
shRep.Range("I3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba]
В тех случаях, когда выводить нечего, т.е. поле "не отправлено ответов" остается пустым...макрос начинает ругаться на выше указанную строку...видимо как раз потому что нечего выводить. Можно ли сделать возможным оба варианта исхода событий?
[moder]Повторное нарушение п.3 Правил форума в части тегов. Игнорирование замечаний администрации. Первое замечание.

Автор - drblasster88
Дата добавления - 18.01.2016 в 21:06
drblasster88 Дата: Воскресенье, 21.02.2016, 17:34 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 18
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Добрый вечер, прошу прощения у администраторов, так был увлечен, что ваше замечание не увидел. Исправлюсь.

Manyasha, Возвращаясь к коду работает отлично. Спасибо большое. Подскажите еще пожалуйста команду вывода значений не в строчку, а в столбец. Как показала практика со строчкой очень не удобно потом работать
[vba]
Код
'Список значений в строчку
                 listStr = listStr & dataBC(i, 1) & ", "
             End If
         End If
     Next i
     shRep.Range("d3") = d1.Count
     shRep.Range("e3") = shRep.Range("c3") - shRep.Range("d3")
     'Выводим общее кол-во
     shRep.Range("i3") = k
     'Выводим кол-во уникальных
     shRep.Range("j3") = d3.Count
     'Выводим весь список значений
     shRep.Range("k3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba]
 
Ответить
СообщениеДобрый вечер, прошу прощения у администраторов, так был увлечен, что ваше замечание не увидел. Исправлюсь.

Manyasha, Возвращаясь к коду работает отлично. Спасибо большое. Подскажите еще пожалуйста команду вывода значений не в строчку, а в столбец. Как показала практика со строчкой очень не удобно потом работать
[vba]
Код
'Список значений в строчку
                 listStr = listStr & dataBC(i, 1) & ", "
             End If
         End If
     Next i
     shRep.Range("d3") = d1.Count
     shRep.Range("e3") = shRep.Range("c3") - shRep.Range("d3")
     'Выводим общее кол-во
     shRep.Range("i3") = k
     'Выводим кол-во уникальных
     shRep.Range("j3") = d3.Count
     'Выводим весь список значений
     shRep.Range("k3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba]

Автор - drblasster88
Дата добавления - 21.02.2016 в 17:34
Manyasha Дата: Вторник, 23.02.2016, 11:56 | Сообщение № 20
Группа: Модераторы
Ранг: Старожил
Сообщений: 1823
Репутация: 765 ±
Замечаний: 0% ±

Excel 2007, 2010
drblasster88, попробуйте так:
[vba]
Код
'Список значений в столбик
                shRep.Range("k" & 3+k) = dataBC(i, 1)
            End If
        End If
    Next i
    shRep.Range("d3") = d1.Count
    shRep.Range("e3") = shRep.Range("c3") - shRep.Range("d3")
    'Выводим общее кол-во
    shRep.Range("i3") = k
    'Выводим кол-во уникальных
    shRep.Range("j3") = d3.Count
    'Выводим весь список значений
    ' shRep.Range("k3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеdrblasster88, попробуйте так:
[vba]
Код
'Список значений в столбик
                shRep.Range("k" & 3+k) = dataBC(i, 1)
            End If
        End If
    Next i
    shRep.Range("d3") = d1.Count
    shRep.Range("e3") = shRep.Range("c3") - shRep.Range("d3")
    'Выводим общее кол-во
    shRep.Range("i3") = k
    'Выводим кол-во уникальных
    shRep.Range("j3") = d3.Count
    'Выводим весь список значений
    ' shRep.Range("k3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba]

Автор - Manyasha
Дата добавления - 23.02.2016 в 11:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос по подсчету уникальных значений (Макросы/Sub)
Страница 1 из 11
Поиск:

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