Доброго времени суток! Дамы и господа, нужна помощь в составлении макроса для сбора отчетности. Если кто-то сможет помочь - буду очень благодарен. Прикладываю 2 файла. В первом файле выгрузка данных из программы, она всегда будет одного формата, но с разным количеством значений, во втором файле отчетная форма в которую нужно вывести количественные значения по собранным данным: -В первом файле в столбце А ищем запись "Решение о приостановлении операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку С3 -В первом файле в столбце А ищем запись "Решение об отмене приостановления операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку F3 -В первом файле в столбце С ищем уникальные записи по маске "BOS1_RPO" и "BOS1_RBN" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку D3 -В первом файле в столбце С ищем уникальные записи по маске "PB2_RPO" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку E3 - В первом файле в столбце B ищем уникальные значения по маске "29000112" и "29000117" считаем только те, напротив которых в столбце не стоят значения "BOS1_RPO", "PB2_RPO" и "BOS1_RBN", т.е. пустые поля, результат выводим в таблицу в ячейку I3
Доброго времени суток! Дамы и господа, нужна помощь в составлении макроса для сбора отчетности. Если кто-то сможет помочь - буду очень благодарен. Прикладываю 2 файла. В первом файле выгрузка данных из программы, она всегда будет одного формата, но с разным количеством значений, во втором файле отчетная форма в которую нужно вывести количественные значения по собранным данным: -В первом файле в столбце А ищем запись "Решение о приостановлении операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку С3 -В первом файле в столбце А ищем запись "Решение об отмене приостановления операций по счетам (НО)", количество найденных записей выводим в отчетную форму в ячейку F3 -В первом файле в столбце С ищем уникальные записи по маске "BOS1_RPO" и "BOS1_RBN" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку D3 -В первом файле в столбце С ищем уникальные записи по маске "PB2_RPO" (считать уникальные значения, т.к. наименования таких записей могут повторяться, а нам нужно считать количество уникальных значений) и их количество выводим в отчетную форму в ячейку E3 - В первом файле в столбце B ищем уникальные значения по маске "29000112" и "29000117" считаем только те, напротив которых в столбце не стоят значения "BOS1_RPO", "PB2_RPO" и "BOS1_RBN", т.е. пустые поля, результат выводим в таблицу в ячейку I3drblasster88
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.]
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
Спасибо Вам огромное!!! Очень выручили! Но есть два вопроса: В первом файле в столбце 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
не по Правилам это! Решать вопросы вне темы разрешается только в разделе Работа/Фриланс. Либо выкладывайте новый файл сюда, либо просите перенести тему.
По Вашим вопросам (файлы из моего поста): 1. Для строк со значениями "29000112" и "29000117" получается 1, т.к. в Выгрузке есть 1 такая строчка. Там объединенные ячейки, и фактически "Статус: Исполнено" стоит на строчку выше, а в текущей и правда пусто (строчку желтым выделила) :) Правильно ли я понимаю, что должно быть не 1, а ноль? Т.е в 3-м столбце по текущему счету везде пусто? См. новый файл, код поправила.
не по Правилам это! Решать вопросы вне темы разрешается только в разделе Работа/Фриланс. Либо выкладывайте новый файл сюда, либо просите перенести тему.
По Вашим вопросам (файлы из моего поста): 1. Для строк со значениями "29000112" и "29000117" получается 1, т.к. в Выгрузке есть 1 такая строчка. Там объединенные ячейки, и фактически "Статус: Исполнено" стоит на строчку выше, а в текущей и правда пусто (строчку желтым выделила) :) Правильно ли я понимаю, что должно быть не 1, а ноль? Т.е в 3-м столбце по текущему счету везде пусто? См. новый файл, код поправила.
Уменьшил выгрузку до допустимого объема. Давайте с ней поработаем. Вы все правильно поняли. Данные вставляются куда нужно. Вот что у меня сейчас Общая загрузка Приостановления Отмены Не отправлено Справок по приостановлениям Всего Справка Отказ Всего ВВБ 164 162 3 9 1
По поводу разности значений в столбце Всего и сумме столбцов Справка и отказ, кажется понял. В Файле причина в самом конце: Там для одного "Решения о приостановлении" два типа ответа "BOS1" и "PB2" из за этого сумма "BOS1" и "PB2" получается больше чем сумма "Решения о приостановлении". Думаю с этим наверно мы ничего не сможем сделать...
А вот по поводу столбца "Не отправлено Справок по приостановлениям" можно ли сделать что-нибудь с объединенной ячейкой? потому что во всех ответах она будет объединена и находиться на той же позиции, различие будет только в том что по 2900012 она будет полностью пустая, а по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен. В выгрузке сделал оба варианта, для удобства я все проблемные варианты поместил внизу, начинайте смотреть после ячейки 2313
Уменьшил выгрузку до допустимого объема. Давайте с ней поработаем. Вы все правильно поняли. Данные вставляются куда нужно. Вот что у меня сейчас Общая загрузка Приостановления Отмены Не отправлено Справок по приостановлениям Всего Справка Отказ Всего ВВБ 164 162 3 9 1
По поводу разности значений в столбце Всего и сумме столбцов Справка и отказ, кажется понял. В Файле причина в самом конце: Там для одного "Решения о приостановлении" два типа ответа "BOS1" и "PB2" из за этого сумма "BOS1" и "PB2" получается больше чем сумма "Решения о приостановлении". Думаю с этим наверно мы ничего не сможем сделать...
А вот по поводу столбца "Не отправлено Справок по приостановлениям" можно ли сделать что-нибудь с объединенной ячейкой? потому что во всех ответах она будет объединена и находиться на той же позиции, различие будет только в том что по 2900012 она будет полностью пустая, а по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен. В выгрузке сделал оба варианта, для удобства я все проблемные варианты поместил внизу, начинайте смотреть после ячейки 2313drblasster88
для одного "Решения о приостановлении" два типа ответа
Код
Всего = Справка+Отказ
так должно быть? Может тогда просто посчитать Всего (С3), Справка (D3), а отказ поставить, как C3-D3?
[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 Trim(dataBC(i - 1, 2)) = "" And Trim(dataBC(i + 1, 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("e3") = shRep.Range("c3") - shRep.Range("d3") shRep.Range("i3") = d3.Count openWb.Close Application.ScreenUpdating = True End Sub
для одного "Решения о приостановлении" два типа ответа
Код
Всего = Справка+Отказ
так должно быть? Может тогда просто посчитать Всего (С3), Справка (D3), а отказ поставить, как C3-D3?
[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 Trim(dataBC(i - 1, 2)) = "" And Trim(dataBC(i + 1, 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("e3") = shRep.Range("c3") - shRep.Range("d3") shRep.Range("i3") = d3.Count openWb.Close Application.ScreenUpdating = True End Sub
Файл не открывается (расширение является не допустимым), сокрее всего из-за того, что Вы расширение вручную поменяли. Да и к тому же вес 0кб[/p.s.]Manyasha
по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен Я может что то не так делаю но у меня в отчет падают пустые только по 29000112...пустые по 29000117 в отчет не попадают. Скажите, а можно сделать, что бы в отчете в ячейку К3 помещались в строчку через запятую полные наименования файлов 29000112 и 29000117 по которым эти самые пустые ячейки?
А по поводу отказов....Я что то не сообразил сразу....наверно так и сделаю. Спасибо вам огромное
по 2900017 возможны два варианта - полностью пустая и с надписью "Статус: Исполнено", последний вариант в отчет попадать не должен Я может что то не так делаю но у меня в отчет падают пустые только по 29000112...пустые по 29000117 в отчет не попадают. Скажите, а можно сделать, что бы в отчете в ячейку К3 помещались в строчку через запятую полные наименования файлов 29000112 и 29000117 по которым эти самые пустые ячейки?
А по поводу отказов....Я что то не сообразил сразу....наверно так и сделаю. Спасибо вам огромноеdrblasster88
Точнее после того как макрос находит одну ячейку пустую, он ставит цифру 1 и больше ничего в отчет не выводится...А мне хотелось бы что б он писал количество пустых. Наверно это связано с тем что в ячейку I3 он тоже выводит только уникальные значения? Там нужно что бы было общее количество всех 29000112 и 29000117 с пустыми ячейками
Точнее после того как макрос находит одну ячейку пустую, он ставит цифру 1 и больше ничего в отчет не выводится...А мне хотелось бы что б он писал количество пустых. Наверно это связано с тем что в ячейку I3 он тоже выводит только уникальные значения? Там нужно что бы было общее количество всех 29000112 и 29000117 с пустыми ячейкамиdrblasster88
в столбце 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]
drblasster88, нашла ошибку [vba]
Код
If d3.Exists(dataBC(i, 2)) = False Then d3.Item(dataBC(i, 2)) = i
[/vba] конечно же там не dataBC(i, 2), а dataBC(i, 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
Да, теперь все идеально! Спасибо Вам большое, вы меня очень выручили!!! Ваши реквизиты работоспособны ЯД: 410013299366744 WM: R193491431804? И последний глупый вопрос: Как мне вывести из выгрузки значение ячейки А8 (там дата выгрузки зашита) в какую-нибудь ячейку отчета?
Да, теперь все идеально! Спасибо Вам большое, вы меня очень выручили!!! Ваши реквизиты работоспособны ЯД: 410013299366744 WM: R193491431804? И последний глупый вопрос: Как мне вывести из выгрузки значение ячейки А8 (там дата выгрузки зашита) в какую-нибудь ячейку отчета?drblasster88
Марин, сможете подсказать как запускать макрос без диалогового окна, что бы не выбирать нужный файлик? Пытаюсь подставить в код команду...не получается Workbooks.Open Filename:= _ "C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm"
Марин, сможете подсказать как запускать макрос без диалогового окна, что бы не выбирать нужный файлик? Пытаюсь подставить в код команду...не получается Workbooks.Open Filename:= _ "C:\Users\Александр\Desktop\Дневной объем ЮЛ.24\Выгрузки за Т-2\ВВБ.xlsm"
Я так пробовал, ругается на последнюю строку [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]
Код
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]
Код
'Выводим весь список значений shRep.Range("I3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba] В тех случаях, когда выводить нечего, т.е. поле "не отправлено ответов" остается пустым...макрос начинает ругаться на выше указанную строку...видимо как раз потому что нечего выводить. Можно ли сделать возможным оба варианта исхода событий? [moder]Повторное нарушение п.3 Правил форума в части тегов. Игнорирование замечаний администрации. Первое замечание.
Странно, а сегодня получилось....мистика Но сегодня другая проблема, после того как вы добавили функцию [vba]
Код
'Выводим весь список значений shRep.Range("I3") = Mid(listStr, 1, Len(listStr) - 2)
[/vba] В тех случаях, когда выводить нечего, т.е. поле "не отправлено ответов" остается пустым...макрос начинает ругаться на выше указанную строку...видимо как раз потому что нечего выводить. Можно ли сделать возможным оба варианта исхода событий? [moder]Повторное нарушение п.3 Правил форума в части тегов. Игнорирование замечаний администрации. Первое замечание.drblasster88
Сообщение отредактировал _Boroda_ - Понедельник, 18.01.2016, 21:30
Добрый вечер, прошу прощения у администраторов, так был увлечен, что ваше замечание не увидел. Исправлюсь.
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)
'Список значений в столбик 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]
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)