Добрый день! Стоит задача переноса данных из файла "База данных" в файл "Исходник" в таблицу (на данный момент таблица уже заполнена теми данными, которыми по условию должна быть заполнена макросом). Условия выгрузки - 3: 1)Указанный вверху "Исходника" холдинг; 2)Количество участников (заявок) >=2; 3) Отклонение >25%. Последние 2 условия подтягиваются в выделенный жирным кусок "Исходника"
Добрый день! Стоит задача переноса данных из файла "База данных" в файл "Исходник" в таблицу (на данный момент таблица уже заполнена теми данными, которыми по условию должна быть заполнена макросом). Условия выгрузки - 3: 1)Указанный вверху "Исходника" холдинг; 2)Количество участников (заявок) >=2; 3) Отклонение >25%. Последние 2 условия подтягиваются в выделенный жирным кусок "Исходника"Maryasha
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr&, i&, r&, wb As Workbook
If Not Intersect(Target, Range("d2")) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False
Cells(5, 2).CurrentRegion.Offset(1).ClearContents Set wb = Workbooks.Open(ThisWorkbook.Path & "\20170718_data.xlsx") r = 5
With wb.Sheets(1) lr = .Cells(Rows.Count, 3).End(xlUp).Row For i = 2 To lr If .Cells(i, "ar") = Cells(2, "d") And _ .Cells(i, "as") >= 0.25 And .Cells(i, "ai") >= 2 Then
Cells(r, "b") = Cells(2, "d").Value Cells(r, "c") = .Cells(i, "d").Value Cells(r, "d") = .Cells(i, "c").Value Cells(r, "e") = .Cells(i, "n").Value Cells(r, "f") = .Cells(i, "o").Value Cells(r, "g") = "В ходе проведения закупки поступило " & _ .Cells(i, "ai") & " заявки, среднее отклонение которых составило " & .Cells(i, "as").Text & " от НМЦ" r = r + 1 End If Next i End With wb.Close False
Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub
[/vba]
Maryasha, проверяйте: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim lr&, i&, r&, wb As Workbook
If Not Intersect(Target, Range("d2")) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False
Cells(5, 2).CurrentRegion.Offset(1).ClearContents Set wb = Workbooks.Open(ThisWorkbook.Path & "\20170718_data.xlsx") r = 5
With wb.Sheets(1) lr = .Cells(Rows.Count, 3).End(xlUp).Row For i = 2 To lr If .Cells(i, "ar") = Cells(2, "d") And _ .Cells(i, "as") >= 0.25 And .Cells(i, "ai") >= 2 Then
Cells(r, "b") = Cells(2, "d").Value Cells(r, "c") = .Cells(i, "d").Value Cells(r, "d") = .Cells(i, "c").Value Cells(r, "e") = .Cells(i, "n").Value Cells(r, "f") = .Cells(i, "o").Value Cells(r, "g") = "В ходе проведения закупки поступило " & _ .Cells(i, "ai") & " заявки, среднее отклонение которых составило " & .Cells(i, "as").Text & " от НМЦ" r = r + 1 End If Next i End With wb.Close False
Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub
Manyasha, добрый день! Спасибо большое за помощь! А лист с данными откуда макрос подтягивает значения должен быть открыт? Если он у меня находится в другой папке макрос будет работать?
Manyasha, добрый день! Спасибо большое за помощь! А лист с данными откуда макрос подтягивает значения должен быть открыт? Если он у меня находится в другой папке макрос будет работать?Maryasha
Пишет "Type mismatch", в макросе ничего не менял, взял с тем же что и БД названием скопировал исходный файл с данными с заменой файла + поменял список из проверки на рабочий. В рабочей БД есть пустые строки и часть данных подтягивается формулами+ лист не один, из-за этого макрос может не работать?
Пишет "Type mismatch", в макросе ничего не менял, взял с тем же что и БД названием скопировал исходный файл с данными с заменой файла + поменял список из проверки на рабочий. В рабочей БД есть пустые строки и часть данных подтягивается формулами+ лист не один, из-за этого макрос может не работать?Maryasha
Сообщение отредактировал Maryasha - Четверг, 20.07.2017, 14:56
Manyasha, Спасибо большое), вставил одно End if в конце, все заработало. Есть несколько вопросов к Вам: 1) в случае если бд будет идти отдельным листом (с тем же названием) что нужно поменять?; 2) Как вставить условия на склонение слов "поступило и заявки". Варианты а) поступила 1 заявка б) поступило 2,3,4 заявки в)поступило 5,6,7... заявок; 3) При копировании предмета договора (столбец N) не учитывать цифры (или же копировать с первой содержащейся в ячейке Буквы) в начале,в обазце их не было Например: вместо "1402-00131, Поставка масла" - "Поставка масла"
Manyasha, Спасибо большое), вставил одно End if в конце, все заработало. Есть несколько вопросов к Вам: 1) в случае если бд будет идти отдельным листом (с тем же названием) что нужно поменять?; 2) Как вставить условия на склонение слов "поступило и заявки". Варианты а) поступила 1 заявка б) поступило 2,3,4 заявки в)поступило 5,6,7... заявок; 3) При копировании предмета договора (столбец N) не учитывать цифры (или же копировать с первой содержащейся в ячейке Буквы) в начале,в обазце их не было Например: вместо "1402-00131, Поставка масла" - "Поставка масла"Maryasha
Сообщение отредактировал Maryasha - Пятница, 21.07.2017, 10:54