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

Вход

Регистрация

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

 

= Мир MS Excel/Автоматическое добавление контрагентов в отчет из др. листов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Автоматическое добавление контрагентов в отчет из др. листов (Формулы/Formulas)
Автоматическое добавление контрагентов в отчет из др. листов
Flatcher Дата: Пятница, 10.04.2015, 12:37 | Сообщение № 1
Группа: Проверенные
Ранг: Участник
Сообщений: 94
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Добрый день. В файле есть лист "База контрагентов" и лист с отчетом "План факт". Подскажите пожалуйста как реализовать автоматически при добавлении нового контрагента добавление новых строк в отчет (желательно с сохранением всех формул)
К сообщению приложен файл: 123.xlsx (10.4 Kb)
 
Ответить
СообщениеДобрый день. В файле есть лист "База контрагентов" и лист с отчетом "План факт". Подскажите пожалуйста как реализовать автоматически при добавлении нового контрагента добавление новых строк в отчет (желательно с сохранением всех формул)
Автор - Flatcher
Дата добавления - 10.04.2015 в 12:37
_Boroda_ Дата: Пятница, 10.04.2015, 12:47 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 17010
Репутация: 6668 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Можно сводную таблицу по диапазону 9999 строк или динамическому.
Обновление или вручную, или автообновление на макрос повесить.
К сообщению приложен файл: 123456789_1.xlsx (13.8 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеМожно сводную таблицу по диапазону 9999 строк или динамическому.
Обновление или вручную, или автообновление на макрос повесить.
Автор - _Boroda_
Дата добавления - 10.04.2015 в 12:47
Flatcher Дата: Пятница, 10.04.2015, 12:52 | Сообщение № 3
Группа: Проверенные
Ранг: Участник
Сообщений: 94
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, первое что я подумал! в таком случае при добавлении новых все формулы "уплывают" и их приходится вручную расставлять
 
Ответить
Сообщение_Boroda_, первое что я подумал! в таком случае при добавлении новых все формулы "уплывают" и их приходится вручную расставлять
Автор - Flatcher
Дата добавления - 10.04.2015 в 12:52
Flatcher Дата: Пятница, 10.04.2015, 13:02 | Сообщение № 4
Группа: Проверенные
Ранг: Участник
Сообщений: 94
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, 1 формула это разница между план и факт. А 2 и 3 это итог план и итог факт. Конечно не проблема их скопировать если других решений нет
 
Ответить
Сообщение_Boroda_, 1 формула это разница между план и факт. А 2 и 3 это итог план и итог факт. Конечно не проблема их скопировать если других решений нет
Автор - Flatcher
Дата добавления - 10.04.2015 в 13:02
МВТ Дата: Пятница, 10.04.2015, 18:44 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
Если Вы планируете только добавлять строки в конец списка (не удалять, не редактировать и т.п. уже имеющиеся строки), то как-то так:
[vba]
Код
Sub Obnova()
Dim L1, L2 As Long
L1 = Sheets("База контрагентов").Cells(Rows.Count, 1).End(xlUp).Row
L2 = Sheets("План факт").Cells(Rows.Count, 1).End(xlUp).Row
If L1 <= (L2 - 1) Then Exit Sub
Sheets("База контрагентов").Range("A" & L2 & ":" & "E" & L1).Copy
Sheets("План факт").Range("A" & L2 & ":" & "E" & L2).Insert Shift:=xlDown
For I = L2 To L1
Cells(I, 2).Formula = "=VLookUp(A" & I & ",'База контрагентов'!$A$2:$B$" & I & ",2 ,0)"
Cells(I, 5).FormulaR1C1 = "=RC[-1]-RC[-2]"
Next I
Cells(L1 + 1, 3).Formula = "=Sum(C2:C" & L1 & ")"
Cells(L1 + 1, 4).Formula = "=Sum(D2:D" & L1 & ")"
End Sub
[/vba]
UPD добавил форматирование через строку и прикрепил файл
К сообщению приложен файл: 2347487.xlsm (22.6 Kb)


Сообщение отредактировал МВТ - Пятница, 10.04.2015, 19:33
 
Ответить
СообщениеЕсли Вы планируете только добавлять строки в конец списка (не удалять, не редактировать и т.п. уже имеющиеся строки), то как-то так:
[vba]
Код
Sub Obnova()
Dim L1, L2 As Long
L1 = Sheets("База контрагентов").Cells(Rows.Count, 1).End(xlUp).Row
L2 = Sheets("План факт").Cells(Rows.Count, 1).End(xlUp).Row
If L1 <= (L2 - 1) Then Exit Sub
Sheets("База контрагентов").Range("A" & L2 & ":" & "E" & L1).Copy
Sheets("План факт").Range("A" & L2 & ":" & "E" & L2).Insert Shift:=xlDown
For I = L2 To L1
Cells(I, 2).Formula = "=VLookUp(A" & I & ",'База контрагентов'!$A$2:$B$" & I & ",2 ,0)"
Cells(I, 5).FormulaR1C1 = "=RC[-1]-RC[-2]"
Next I
Cells(L1 + 1, 3).Formula = "=Sum(C2:C" & L1 & ")"
Cells(L1 + 1, 4).Formula = "=Sum(D2:D" & L1 & ")"
End Sub
[/vba]
UPD добавил форматирование через строку и прикрепил файл
Автор - МВТ
Дата добавления - 10.04.2015 в 18:44
Flatcher Дата: Суббота, 11.04.2015, 06:59 | Сообщение № 6
Группа: Проверенные
Ранг: Участник
Сообщений: 94
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
МВТ, спасибо
 
Ответить
СообщениеМВТ, спасибо
Автор - Flatcher
Дата добавления - 11.04.2015 в 06:59
МВТ Дата: Суббота, 11.04.2015, 22:34 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
Flatcher, немного переделал, теперь должна работать со всеми изменениями, попробуйте
[vba]
Код
Sub Obnova()
Dim L1, L2, L3 As Long
L1 = Sheets("База контрагентов").Cells(Rows.Count, 1).End(xlUp).Row
L2 = Sheets("План факт").Cells(Rows.Count, 1).End(xlUp).Row
L3 = Sheets("Запас").Cells(Rows.Count, 1).End(xlUp).Row
If L1 <= (L2 - 1) Then Exit Sub
Application.ScreenUpdating = False
Sheets("План факт").Activate
Worksheets("Запас").Range("A2:E" & L3).Clear
Range("A2:E" & L2).Copy Destination:=Sheets("Запас").Range("A2:E" & L2)
Range("A2:E" & L2).Clear
Sheets("База контрагентов").Range("A2:" & "E" & L1).Copy Destination:=Sheets("План факт").Range("A2:" & "E" & L1)
Range("B2:B" & L1).FormulaR1C1 = "=IfError(VLookUp(RC[-1], 'База контрагентов'!R2C1:R" & L1 & "C2, 2 ,0)," & """""" & ")"
Range("C2:C" & L1).FormulaR1C1 = "=IfError(VLookup(RC[-2],'Запас'!R2C1:R" & L1 & "C3, 3, 0)," & """""" & ")"
Range("D2:D" & L1).FormulaR1C1 = "=IfError(VLookup(RC[-3],'Запас'!R2C1:R" & L1 & "C4, 4, 0)," & """""" & ")"
With Range("C2:D" & L1): .Formula = .Value: End With
Cells(L1 + 1, 1).Value = "Итого"
Cells(L1 + 1, 3).Formula = "=Sum(C2:C" & L1 & ")"
Cells(L1 + 1, 4).Formula = "=Sum(D2:D" & L1 & ")"
Range("E2:E" & L1).FormulaR1C1 = "=RC[-1] - RC[-2]"
Sheets("Запас").Range("A2:E3").Copy
Range("A2" & I & ":E" & L1 + 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = True
Range("A" & L1 + 1 & ":E" & L1 + 1).Font.Bold = True
End Sub
[/vba]
Будьте внимательны: макрос ссылается на лист "Запас", в приложенном файле он скрыт, но есть
К сообщению приложен файл: 6584105.xlsm (25.9 Kb)
 
Ответить
СообщениеFlatcher, немного переделал, теперь должна работать со всеми изменениями, попробуйте
[vba]
Код
Sub Obnova()
Dim L1, L2, L3 As Long
L1 = Sheets("База контрагентов").Cells(Rows.Count, 1).End(xlUp).Row
L2 = Sheets("План факт").Cells(Rows.Count, 1).End(xlUp).Row
L3 = Sheets("Запас").Cells(Rows.Count, 1).End(xlUp).Row
If L1 <= (L2 - 1) Then Exit Sub
Application.ScreenUpdating = False
Sheets("План факт").Activate
Worksheets("Запас").Range("A2:E" & L3).Clear
Range("A2:E" & L2).Copy Destination:=Sheets("Запас").Range("A2:E" & L2)
Range("A2:E" & L2).Clear
Sheets("База контрагентов").Range("A2:" & "E" & L1).Copy Destination:=Sheets("План факт").Range("A2:" & "E" & L1)
Range("B2:B" & L1).FormulaR1C1 = "=IfError(VLookUp(RC[-1], 'База контрагентов'!R2C1:R" & L1 & "C2, 2 ,0)," & """""" & ")"
Range("C2:C" & L1).FormulaR1C1 = "=IfError(VLookup(RC[-2],'Запас'!R2C1:R" & L1 & "C3, 3, 0)," & """""" & ")"
Range("D2:D" & L1).FormulaR1C1 = "=IfError(VLookup(RC[-3],'Запас'!R2C1:R" & L1 & "C4, 4, 0)," & """""" & ")"
With Range("C2:D" & L1): .Formula = .Value: End With
Cells(L1 + 1, 1).Value = "Итого"
Cells(L1 + 1, 3).Formula = "=Sum(C2:C" & L1 & ")"
Cells(L1 + 1, 4).Formula = "=Sum(D2:D" & L1 & ")"
Range("E2:E" & L1).FormulaR1C1 = "=RC[-1] - RC[-2]"
Sheets("Запас").Range("A2:E3").Copy
Range("A2" & I & ":E" & L1 + 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = True
Range("A" & L1 + 1 & ":E" & L1 + 1).Font.Bold = True
End Sub
[/vba]
Будьте внимательны: макрос ссылается на лист "Запас", в приложенном файле он скрыт, но есть
Автор - МВТ
Дата добавления - 11.04.2015 в 22:34
Роза Дата: Понедельник, 28.03.2016, 13:54 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
МВТ, помогите и мне с решением проблемы с формулой
[moder]Читаем Правила форума, создаем свою тему! [/moder]


Сообщение отредактировал Manyasha - Понедельник, 28.03.2016, 13:56
 
Ответить
СообщениеМВТ, помогите и мне с решением проблемы с формулой
[moder]Читаем Правила форума, создаем свою тему! [/moder]
Автор - Роза
Дата добавления - 28.03.2016 в 13:54
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Автоматическое добавление контрагентов в отчет из др. листов (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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