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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных из другого файла с созданием таблицы - Мир MS Excel

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

Excel 2013
Добрый день! Стоит задача переноса данных из файла "База данных" в файл "Исходник" в таблицу (на данный момент таблица уже заполнена теми данными, которыми по условию должна быть заполнена макросом). Условия выгрузки - 3:
1)Указанный вверху "Исходника" холдинг;
2)Количество участников (заявок) >=2;
3) Отклонение >25%.
Последние 2 условия подтягиваются в выделенный жирным кусок "Исходника"
К сообщению приложен файл: 4670460.xlsx (10.1 Kb) · 1730002.xlsx (15.9 Kb)
 
Ответить
СообщениеДобрый день! Стоит задача переноса данных из файла "База данных" в файл "Исходник" в таблицу (на данный момент таблица уже заполнена теми данными, которыми по условию должна быть заполнена макросом). Условия выгрузки - 3:
1)Указанный вверху "Исходника" холдинг;
2)Количество участников (заявок) >=2;
3) Отклонение >25%.
Последние 2 условия подтягиваются в выделенный жирным кусок "Исходника"

Автор - Maryasha
Дата добавления - 17.07.2017 в 11:06
Maryasha Дата: Понедельник, 17.07.2017, 18:38 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
 
Ответить
Сообщениеhttps://www.google.ru/search?....jBDjNM:

Автор - Maryasha
Дата добавления - 17.07.2017 в 18:38
Manyasha Дата: Вторник, 18.07.2017, 11:16 | Сообщение № 3
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
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
[/vba]
К сообщению приложен файл: 4670460-1.xlsm (17.4 Kb) · 20170718_data.xlsx (15.9 Kb)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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
[/vba]

Автор - Manyasha
Дата добавления - 18.07.2017 в 11:16
Maryasha Дата: Четверг, 20.07.2017, 12:55 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Manyasha, добрый день!
Спасибо большое за помощь!
А лист с данными откуда макрос подтягивает значения должен быть открыт? Если он у меня находится в другой папке макрос будет работать?
 
Ответить
СообщениеManyasha, добрый день!
Спасибо большое за помощь!
А лист с данными откуда макрос подтягивает значения должен быть открыт? Если он у меня находится в другой папке макрос будет работать?

Автор - Maryasha
Дата добавления - 20.07.2017 в 12:55
_Boroda_ Дата: Четверг, 20.07.2017, 12:58 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16654
Репутация: 6475 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Set wb = Workbooks.Open(ThisWorkbook.Path & "\20170718_data.xlsx")

Вот здесь книга, откуда копируют, открывается


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Set wb = Workbooks.Open(ThisWorkbook.Path & "\20170718_data.xlsx")

Вот здесь книга, откуда копируют, открывается

Автор - _Boroda_
Дата добавления - 20.07.2017 в 12:58
Maryasha Дата: Четверг, 20.07.2017, 13:00 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
_Boroda_, ок
 
Ответить
Сообщение_Boroda_, ок

Автор - Maryasha
Дата добавления - 20.07.2017 в 13:00
Maryasha Дата: Четверг, 20.07.2017, 14:46 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Пишет "Type mismatch", в макросе ничего не менял, взял с тем же что и БД названием скопировал исходный файл с данными с заменой файла + поменял список из проверки на рабочий. В рабочей БД есть пустые строки и часть данных подтягивается формулами+ лист не один, из-за этого макрос может не работать?


Сообщение отредактировал Maryasha - Четверг, 20.07.2017, 14:56
 
Ответить
СообщениеПишет "Type mismatch", в макросе ничего не менял, взял с тем же что и БД названием скопировал исходный файл с данными с заменой файла + поменял список из проверки на рабочий. В рабочей БД есть пустые строки и часть данных подтягивается формулами+ лист не один, из-за этого макрос может не работать?

Автор - Maryasha
Дата добавления - 20.07.2017 в 14:46
Manyasha Дата: Четверг, 20.07.2017, 15:03 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Maryasha, а на какой строчке ошибка?
лист не один

Данные берутся с 1-го листа:
[vba]
Код
With wb.Sheets(1)
[/vba]

Покажите кусок файла БД, в котором ошибка.


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеMaryasha, а на какой строчке ошибка?
лист не один

Данные берутся с 1-го листа:
[vba]
Код
With wb.Sheets(1)
[/vba]

Покажите кусок файла БД, в котором ошибка.

Автор - Manyasha
Дата добавления - 20.07.2017 в 15:03
Maryasha Дата: Четверг, 20.07.2017, 15:26 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Теперь просто ничего не подтягивает, вот образец рабочего файла. Может быть из-за #ДЕЛ/0! в столбце AS макрос не срабатывает?
К сообщению приложен файл: tender-export-1.xlsx (22.4 Kb)


Сообщение отредактировал Maryasha - Четверг, 20.07.2017, 15:39
 
Ответить
СообщениеТеперь просто ничего не подтягивает, вот образец рабочего файла. Может быть из-за #ДЕЛ/0! в столбце AS макрос не срабатывает?

Автор - Maryasha
Дата добавления - 20.07.2017 в 15:26
Maryasha Дата: Четверг, 20.07.2017, 15:45 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Manyasha
Вот в этой строчке
[vba]
Код

If .Cells(i, "ar") = Cells(2, "d") And _
.Cells(i, "as") >= 0.25 And .Cells(i, "ai") >= 2 Then
[/vba]


Сообщение отредактировал Maryasha - Четверг, 20.07.2017, 15:47
 
Ответить
СообщениеManyasha
Вот в этой строчке
[vba]
Код

If .Cells(i, "ar") = Cells(2, "d") And _
.Cells(i, "as") >= 0.25 And .Cells(i, "ai") >= 2 Then
[/vba]

Автор - Maryasha
Дата добавления - 20.07.2017 в 15:45
Manyasha Дата: Четверг, 20.07.2017, 16:26 | Сообщение № 11
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Maryasha, добавьте проверку на ошибку либо в макрос:
[vba]
Код
                If Not IsError(.Cells(i, "as")) Then
                    If .Cells(i, "ar") = Cells(2, "d") And _
                        .Cells(i, "as") >= 0.25 And .Cells(i, "ai") >= 2 Then
[/vba]
либо саму формулу в стобце AS запихните в
Код
=ЕСЛИОШИБКА(формула;0)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеMaryasha, добавьте проверку на ошибку либо в макрос:
[vba]
Код
                If Not IsError(.Cells(i, "as")) Then
                    If .Cells(i, "ar") = Cells(2, "d") And _
                        .Cells(i, "as") >= 0.25 And .Cells(i, "ai") >= 2 Then
[/vba]
либо саму формулу в стобце AS запихните в
Код
=ЕСЛИОШИБКА(формула;0)

Автор - Manyasha
Дата добавления - 20.07.2017 в 16:26
Maryasha Дата: Четверг, 20.07.2017, 16:47 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Ошибка "Next without For"
 
Ответить
СообщениеОшибка "Next without For"

Автор - Maryasha
Дата добавления - 20.07.2017 в 16:47
Manyasha Дата: Четверг, 20.07.2017, 17:09 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеMaryasha, Оператор ветвления If…Then…Else…End if

Автор - Manyasha
Дата добавления - 20.07.2017 в 17:09
Maryasha Дата: Пятница, 21.07.2017, 10:47 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Manyasha, Спасибо большое), вставил одно End if в конце, все заработало. Есть несколько вопросов к Вам:
1) в случае если бд будет идти отдельным листом (с тем же названием) что нужно поменять?;
2) Как вставить условия на склонение слов "поступило и заявки". Варианты
а) поступила 1 заявка
б) поступило 2,3,4 заявки
в)поступило 5,6,7... заявок;
3) При копировании предмета договора (столбец N) не учитывать цифры (или же копировать с первой содержащейся в ячейке Буквы) в начале,в обазце их не было
Например: вместо "1402-00131, Поставка масла" - "Поставка масла"


Сообщение отредактировал Maryasha - Пятница, 21.07.2017, 10:54
 
Ответить
СообщениеManyasha, Спасибо большое), вставил одно End if в конце, все заработало. Есть несколько вопросов к Вам:
1) в случае если бд будет идти отдельным листом (с тем же названием) что нужно поменять?;
2) Как вставить условия на склонение слов "поступило и заявки". Варианты
а) поступила 1 заявка
б) поступило 2,3,4 заявки
в)поступило 5,6,7... заявок;
3) При копировании предмета договора (столбец N) не учитывать цифры (или же копировать с первой содержащейся в ячейке Буквы) в начале,в обазце их не было
Например: вместо "1402-00131, Поставка масла" - "Поставка масла"

Автор - Maryasha
Дата добавления - 21.07.2017 в 10:47
Maryasha Дата: Четверг, 27.07.2017, 11:14 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Update
 
Ответить
СообщениеUpdate

Автор - Maryasha
Дата добавления - 27.07.2017 в 11:14
Manyasha Дата: Четверг, 27.07.2017, 11:23 | Сообщение № 16
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Maryasha,
в случае если бд будет идти отдельным листом (с тем же названием) что нужно поменять?
в этой строчке: [vba]
Код
With wb.Sheets(1)
[/vba]поменяйте книгу и лист на нужные: [vba]
Код
'Set wb = Workbooks.Open(ThisWorkbook.Path & "\20170718_data.xlsx")'Уже не нужно
With thisworkbook.Sheets("база")
[/vba]

Как вставить условия на склонение слов "поступило и заявки"
Надо в отдельныю тему.

При копировании предмета договора (столбец N) не учитывать цифры
Почему сразу такие варианты в примере не показали? Не пришлось бы переделывать. Приложите файл со всеми вариантами предмета договора.


ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Четверг, 27.07.2017, 11:24
 
Ответить
СообщениеMaryasha,
в случае если бд будет идти отдельным листом (с тем же названием) что нужно поменять?
в этой строчке: [vba]
Код
With wb.Sheets(1)
[/vba]поменяйте книгу и лист на нужные: [vba]
Код
'Set wb = Workbooks.Open(ThisWorkbook.Path & "\20170718_data.xlsx")'Уже не нужно
With thisworkbook.Sheets("база")
[/vba]

Как вставить условия на склонение слов "поступило и заявки"
Надо в отдельныю тему.

При копировании предмета договора (столбец N) не учитывать цифры
Почему сразу такие варианты в примере не показали? Не пришлось бы переделывать. Приложите файл со всеми вариантами предмета договора.

Автор - Manyasha
Дата добавления - 27.07.2017 в 11:23
Maryasha Дата: Четверг, 27.07.2017, 18:16 | Сообщение № 17
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Manyasha, мерси
К сообщению приложен файл: 7061361.xlsx (17.2 Kb)
 
Ответить
СообщениеManyasha, мерси

Автор - Maryasha
Дата добавления - 27.07.2017 в 18:16
Manyasha Дата: Четверг, 27.07.2017, 18:54 | Сообщение № 18
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Maryasha, вместо строчки [vba]
Код
Cells(r, "e") = .Cells(i, "n").Value
[/vba]напишите
[vba]
Код
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "^[\d-_,]*"
    Cells(r, "e") = Trim(.Replace(ThisWorkbook.Sheets("база").Cells(i, "n").Value, ""))
End With
[/vba]


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеMaryasha, вместо строчки [vba]
Код
Cells(r, "e") = .Cells(i, "n").Value
[/vba]напишите
[vba]
Код
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "^[\d-_,]*"
    Cells(r, "e") = Trim(.Replace(ThisWorkbook.Sheets("база").Cells(i, "n").Value, ""))
End With
[/vba]

Автор - Manyasha
Дата добавления - 27.07.2017 в 18:54
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных из другого файла с созданием таблицы (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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