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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос_калькуляция стоимости - Мир MS Excel

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

Excel 2007
Ребята, привет!
Записал макрос для выполнения однотипных действий в нескольких книгах.
В книге экземпляр находится форма таблицы, которую нужно вставить в каждую открываемую книгу, в новую форму переносятся данные из старой таблицы в каждом листе. Проблема в том, что затем, при запуске макроса, он останавливается на этапе копирования формы таблицы из файла экземпляр, плюс в каждой книге разное число листов, у них разные названия.
Указанный ниже макрос копировал мои действия на примере.
Помогите доработать текст макроса.

[vba]
Код
Sub Калькуляция()
'
' Калькуляция Макрос
'
' Сочетание клавиш: Ctrl+r
'
     Sheets.Select
     Sheets(1).Activate
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Windows("экземпляр.xlsx").Activate
     Range("A1:D31").Select
     Selection.Copy
     Windows("Калькуляция Азов.xls").Activate
     ActiveWindow.SmallScroll Down:=-9
     Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False
     ActiveSheet.Paste
     ActiveWindow.SmallScroll Down:=33
     Range("D48").Select
     Application.CutCopyMode = False
     ActiveCell.FormulaR1C1 = "1"
     Range("D49").Select
     ActiveCell.FormulaR1C1 = "2"
     Range("D48:D49").Select
     ActiveWindow.SmallScroll Down:=9
     Selection.AutoFill Destination:=Range("D48:D59"), Type:=xlFillDefault
     Range("D48:D59").Select
     ActiveWindow.SmallScroll Down:=-51
     Range("A2").Select
     ActiveWindow.SmallScroll Down:=24
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A4").Select
     ActiveWindow.SmallScroll Down:=24
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A5").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("A7").Select
     ActiveWindow.SmallScroll Down:=27
     ActiveCell.FormulaR1C1 = "=R[35]C[1]"
     Range("A8").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("B15").Select
     ActiveWindow.SmallScroll Down:=30
     ActiveCell.FormulaR1C1 = "=R[33]C"
     Range("B16").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("B18").Select
     ActiveWindow.SmallScroll Down:=33
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B19").Select
     ActiveWindow.SmallScroll Down:=33
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B20").Select
     ActiveWindow.SmallScroll Down:=18
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B21").Select
     ActiveWindow.SmallScroll Down:=27
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B22").Select
     ActiveWindow.SmallScroll Down:=12
     ActiveCell.FormulaR1C1 = "=R[28]C"
     Range("B23").Select
     ActiveWindow.SmallScroll Down:=-12
     Range("B24").Select
     ActiveWindow.SmallScroll Down:=39
     ActiveCell.FormulaR1C1 = "=R[32]C"
     Range("B25").Select
     ActiveWindow.SmallScroll Down:=21
     ActiveCell.FormulaR1C1 = "=R[27]C+R[28]C+R[29]C+R[30]C"
     Range("B26").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("B27").Select
     ActiveWindow.SmallScroll Down:=27
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B28").Select
     ActiveWindow.SmallScroll Down:=-57
     Range("A1:D31").Select
     ActiveWindow.SmallScroll Down:=-24
     Range("B14:D28").Select
     Selection.NumberFormat = "#,##0.00"
     Range("A1:D31").Select
     ActiveWindow.SmallScroll Down:=-42
     Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     ActiveWindow.SmallScroll Down:=24
     Rows("32:42").Select
     Application.CutCopyMode = False
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     ActiveWindow.SmallScroll Down:=-48
     Range("A1").Select
     ActiveWindow.SmallScroll Down:=-12
End Sub
[/vba]
К сообщению приложен файл: 4447718.xls (39.0 Kb) · 0587641.xlsx (14.4 Kb)
 
Ответить
СообщениеРебята, привет!
Записал макрос для выполнения однотипных действий в нескольких книгах.
В книге экземпляр находится форма таблицы, которую нужно вставить в каждую открываемую книгу, в новую форму переносятся данные из старой таблицы в каждом листе. Проблема в том, что затем, при запуске макроса, он останавливается на этапе копирования формы таблицы из файла экземпляр, плюс в каждой книге разное число листов, у них разные названия.
Указанный ниже макрос копировал мои действия на примере.
Помогите доработать текст макроса.

[vba]
Код
Sub Калькуляция()
'
' Калькуляция Макрос
'
' Сочетание клавиш: Ctrl+r
'
     Sheets.Select
     Sheets(1).Activate
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Windows("экземпляр.xlsx").Activate
     Range("A1:D31").Select
     Selection.Copy
     Windows("Калькуляция Азов.xls").Activate
     ActiveWindow.SmallScroll Down:=-9
     Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False
     ActiveSheet.Paste
     ActiveWindow.SmallScroll Down:=33
     Range("D48").Select
     Application.CutCopyMode = False
     ActiveCell.FormulaR1C1 = "1"
     Range("D49").Select
     ActiveCell.FormulaR1C1 = "2"
     Range("D48:D49").Select
     ActiveWindow.SmallScroll Down:=9
     Selection.AutoFill Destination:=Range("D48:D59"), Type:=xlFillDefault
     Range("D48:D59").Select
     ActiveWindow.SmallScroll Down:=-51
     Range("A2").Select
     ActiveWindow.SmallScroll Down:=24
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A4").Select
     ActiveWindow.SmallScroll Down:=24
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A5").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("A7").Select
     ActiveWindow.SmallScroll Down:=27
     ActiveCell.FormulaR1C1 = "=R[35]C[1]"
     Range("A8").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("B15").Select
     ActiveWindow.SmallScroll Down:=30
     ActiveCell.FormulaR1C1 = "=R[33]C"
     Range("B16").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("B18").Select
     ActiveWindow.SmallScroll Down:=33
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B19").Select
     ActiveWindow.SmallScroll Down:=33
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B20").Select
     ActiveWindow.SmallScroll Down:=18
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B21").Select
     ActiveWindow.SmallScroll Down:=27
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B22").Select
     ActiveWindow.SmallScroll Down:=12
     ActiveCell.FormulaR1C1 = "=R[28]C"
     Range("B23").Select
     ActiveWindow.SmallScroll Down:=-12
     Range("B24").Select
     ActiveWindow.SmallScroll Down:=39
     ActiveCell.FormulaR1C1 = "=R[32]C"
     Range("B25").Select
     ActiveWindow.SmallScroll Down:=21
     ActiveCell.FormulaR1C1 = "=R[27]C+R[28]C+R[29]C+R[30]C"
     Range("B26").Select
     ActiveWindow.SmallScroll Down:=-9
     Range("B27").Select
     ActiveWindow.SmallScroll Down:=27
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B28").Select
     ActiveWindow.SmallScroll Down:=-57
     Range("A1:D31").Select
     ActiveWindow.SmallScroll Down:=-24
     Range("B14:D28").Select
     Selection.NumberFormat = "#,##0.00"
     Range("A1:D31").Select
     ActiveWindow.SmallScroll Down:=-42
     Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     ActiveWindow.SmallScroll Down:=24
     Rows("32:42").Select
     Application.CutCopyMode = False
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     ActiveWindow.SmallScroll Down:=-48
     Range("A1").Select
     ActiveWindow.SmallScroll Down:=-12
End Sub
[/vba]
Автор - Мурад
Дата добавления - 17.11.2014 в 15:10
Мурад Дата: Понедельник, 17.11.2014, 15:26 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Забыл уточнить, что мне пришлось немного отредактировать макрос. Так, название первого листа я поменял на 1, т.к. получались иероглифы.
 
Ответить
СообщениеЗабыл уточнить, что мне пришлось немного отредактировать макрос. Так, название первого листа я поменял на 1, т.к. получались иероглифы.
Автор - Мурад
Дата добавления - 17.11.2014 в 15:26
Мурад Дата: Понедельник, 17.11.2014, 17:00 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
вроде задача нетрудная, но я запутался в каком месте использовать коллекции и как вытащить форму таблицы из другого файла. как затем переместиться в другой файл и выполнить указанный ряд операций, начиная с вставки 30 строк (указано в тексте макроса)


Сообщение отредактировал Мурад - Понедельник, 17.11.2014, 17:02
 
Ответить
Сообщениевроде задача нетрудная, но я запутался в каком месте использовать коллекции и как вытащить форму таблицы из другого файла. как затем переместиться в другой файл и выполнить указанный ряд операций, начиная с вставки 30 строк (указано в тексте макроса)
Автор - Мурад
Дата добавления - 17.11.2014 в 17:00
Мурад Дата: Понедельник, 17.11.2014, 18:23 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
имеются два файла. подскажите, после того как скопировал данные в одном файле, каким образом в макросе перейти в другой файл для вставки туда данных, без указания в последнем случае конкретного имени файла? т.е.

[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
      Range("A1:D31").Select
      Selection.Copy
      ???Workbooks.Activate???
[/vba]


Сообщение отредактировал Мурад - Понедельник, 17.11.2014, 18:24
 
Ответить
Сообщениеимеются два файла. подскажите, после того как скопировал данные в одном файле, каким образом в макросе перейти в другой файл для вставки туда данных, без указания в последнем случае конкретного имени файла? т.е.

[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
      Range("A1:D31").Select
      Selection.Copy
      ???Workbooks.Activate???
[/vba]
Автор - Мурад
Дата добавления - 17.11.2014 в 18:23
Мурад Дата: Понедельник, 17.11.2014, 18:31 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
ладно, буду дальше говорить сам с собой)
представляю апогей моих мыслей, дальше мне сложно разобраться самому. после того, как мы скопировали данные в экземпляре, переходим в нужную книгу:
[vba]
Код
ThisWorkbook.Worksheets(1).Activate
     For i = 1 To ActiveWorkbook.Sheets.Count
     Sheets(i).Activate
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False
     ActiveSheet.Paste
     Range("D48").Select
     Application.CutCopyMode = False
     ActiveCell.FormulaR1C1 = "1"
     Range("D49").Select
     ActiveCell.FormulaR1C1 = "2"
     Range("D48:D49").Select
     Selection.AutoFill Destination:=Range("D48:D59"), Type:=xlFillDefault
     Range("D48:D59").Select
     Range("A2").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A4").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A5").Select
     Range("A7").Select
     ActiveCell.FormulaR1C1 = "=R[35]C[1]"
     Range("A8").Select
     Range("B15").Select
     ActiveCell.FormulaR1C1 = "=R[33]C"
     Range("B16").Select
     Range("B18").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B19").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B20").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B21").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B22").Select
     ActiveCell.FormulaR1C1 = "=R[28]C"
     Range("B23").Select
     Range("B24").Select
     ActiveCell.FormulaR1C1 = "=R[32]C"
     Range("B25").Select
     ActiveCell.FormulaR1C1 = "=R[27]C+R[28]C+R[29]C+R[30]C"
     Range("B26").Select
     Range("B27").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B28").Select
     Range("A1:D31").Select
     Range("B14:D28").Select
     Selection.NumberFormat = "#,##0.00"
     Range("A1:D31").Select
     Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     Rows("32:42").Select
     Application.CutCopyMode = False
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Range("A1").Select
     Next i
[/vba]
 
Ответить
Сообщениеладно, буду дальше говорить сам с собой)
представляю апогей моих мыслей, дальше мне сложно разобраться самому. после того, как мы скопировали данные в экземпляре, переходим в нужную книгу:
[vba]
Код
ThisWorkbook.Worksheets(1).Activate
     For i = 1 To ActiveWorkbook.Sheets.Count
     Sheets(i).Activate
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False
     ActiveSheet.Paste
     Range("D48").Select
     Application.CutCopyMode = False
     ActiveCell.FormulaR1C1 = "1"
     Range("D49").Select
     ActiveCell.FormulaR1C1 = "2"
     Range("D48:D49").Select
     Selection.AutoFill Destination:=Range("D48:D59"), Type:=xlFillDefault
     Range("D48:D59").Select
     Range("A2").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A4").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A5").Select
     Range("A7").Select
     ActiveCell.FormulaR1C1 = "=R[35]C[1]"
     Range("A8").Select
     Range("B15").Select
     ActiveCell.FormulaR1C1 = "=R[33]C"
     Range("B16").Select
     Range("B18").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B19").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B20").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B21").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B22").Select
     ActiveCell.FormulaR1C1 = "=R[28]C"
     Range("B23").Select
     Range("B24").Select
     ActiveCell.FormulaR1C1 = "=R[32]C"
     Range("B25").Select
     ActiveCell.FormulaR1C1 = "=R[27]C+R[28]C+R[29]C+R[30]C"
     Range("B26").Select
     Range("B27").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B28").Select
     Range("A1:D31").Select
     Range("B14:D28").Select
     Selection.NumberFormat = "#,##0.00"
     Range("A1:D31").Select
     Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     Rows("32:42").Select
     Application.CutCopyMode = False
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Range("A1").Select
     Next i
[/vba]
Автор - Мурад
Дата добавления - 17.11.2014 в 18:31
alex1248 Дата: Понедельник, 17.11.2014, 18:34 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 384
Репутация: 71 ±
Замечаний: 0% ±

Excel 2007, 2010
Цитата Мурад, 17.11.2014 в 18:23, в сообщении № 4
каким образом в макросе перейти в другой файл для вставки туда данных, без указания в последнем случае конкретного имени файла?

Можно, например, заранее присвоить переменной типа Object значение, равное данному файлу (сорри за возможные неточности в терминологии).
А по поводу первого вопроса - вам бы следовало показать, что вам нужно, а не загадывать загадку разобраться в записи макрорекордера. :)

skype alex12481632
Qiwi +79276708519
 
Ответить
Сообщение
Цитата Мурад, 17.11.2014 в 18:23, в сообщении № 4
каким образом в макросе перейти в другой файл для вставки туда данных, без указания в последнем случае конкретного имени файла?

Можно, например, заранее присвоить переменной типа Object значение, равное данному файлу (сорри за возможные неточности в терминологии).
А по поводу первого вопроса - вам бы следовало показать, что вам нужно, а не загадывать загадку разобраться в записи макрорекордера. :)
Автор - alex1248
Дата добавления - 17.11.2014 в 18:34
Мурад Дата: Понедельник, 17.11.2014, 18:40 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Алекс, спасибо за отклик! Не пугайтесь длинному коду. выбросьте все лишнее. мне нужна помощь в куске:
[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
     Range("A1:D31").Select
     Selection.Copy
ThisWorkbook.Worksheets(1).Activate
     For i = 1 To ActiveWorkbook.Sheets.Count
...
next i

[/vba]
 
Ответить
СообщениеАлекс, спасибо за отклик! Не пугайтесь длинному коду. выбросьте все лишнее. мне нужна помощь в куске:
[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
     Range("A1:D31").Select
     Selection.Copy
ThisWorkbook.Worksheets(1).Activate
     For i = 1 To ActiveWorkbook.Sheets.Count
...
next i

[/vba]
Автор - Мурад
Дата добавления - 17.11.2014 в 18:40
Мурад Дата: Понедельник, 17.11.2014, 18:42 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
у меня в активной книге не выполняются команды, заключенные в операторе for i ... next. Не знаю, где ошибка
 
Ответить
Сообщениеу меня в активной книге не выполняются команды, заключенные в операторе for i ... next. Не знаю, где ошибка
Автор - Мурад
Дата добавления - 17.11.2014 в 18:42
RAN Дата: Понедельник, 17.11.2014, 18:42 | Сообщение № 9
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
     Sheets ("Нужный").Select
     Range("A1:D31").Select
[/vba]

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
     Sheets ("Нужный").Select
     Range("A1:D31").Select
[/vba]
Автор - RAN
Дата добавления - 17.11.2014 в 18:42
Мурад Дата: Вторник, 18.11.2014, 10:08 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Почему у меня не работает процедура?

[vba]
Код
Sub калько()
For i = 1 To ThisWorkbook.Sheets.Count
     ThisWorkbook.Sheets(i).Activate
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
End Sub
[/vba]
 
Ответить
СообщениеПочему у меня не работает процедура?

[vba]
Код
Sub калько()
For i = 1 To ThisWorkbook.Sheets.Count
     ThisWorkbook.Sheets(i).Activate
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
End Sub
[/vba]
Автор - Мурад
Дата добавления - 18.11.2014 в 10:08
Мурад Дата: Вторник, 18.11.2014, 10:14 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
при запуске ничего не происходит, строки не вставляются
 
Ответить
Сообщениепри запуске ничего не происходит, строки не вставляются
Автор - Мурад
Дата добавления - 18.11.2014 в 10:14
nilem Дата: Вторник, 18.11.2014, 10:23 | Сообщение № 12
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
проверил на всякий случай. Все работает, вставляется.

Яндекс.Деньги 4100159601573
 
Ответить
Сообщениепроверил на всякий случай. Все работает, вставляется.
Автор - nilem
Дата добавления - 18.11.2014 в 10:23
Мурад Дата: Вторник, 18.11.2014, 10:25 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
у меня заработало только после вставки sheets(1).select

[vba]
Код
Sub калько()
Sheets(1).Select
For i = 1 To Sheets.Count
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
End Sub
[/vba]
 
Ответить
Сообщениеу меня заработало только после вставки sheets(1).select

[vba]
Код
Sub калько()
Sheets(1).Select
For i = 1 To Sheets.Count
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
End Sub
[/vba]
Автор - Мурад
Дата добавления - 18.11.2014 в 10:25
Мурад Дата: Вторник, 18.11.2014, 10:34 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
после того, как я скопировал таблицу из одного файла:
[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
     Sheets(1).Select
     Range("A1:D31").Select
     Selection.Copy
[/vba]

не могу вставить эту таблицу в заготовленное для нее место в другом файле
[vba]
Код
ThisWorkbook.Worksheets(1).Activate
     Sheets(1).Select
     For i = 1 To Sheets.Count
     Sheets(i).Select
     Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False
     ActiveSheet.Paste
[/vba]

((( ну где я ошибся?)) уже сутки решаю эту задачу))
делал все по шагам, в буфере информация хранится, но вставка не происходит
 
Ответить
Сообщениепосле того, как я скопировал таблицу из одного файла:
[vba]
Код
Workbooks.Open ("экземпляр.xlsx")
     Sheets(1).Select
     Range("A1:D31").Select
     Selection.Copy
[/vba]

не могу вставить эту таблицу в заготовленное для нее место в другом файле
[vba]
Код
ThisWorkbook.Worksheets(1).Activate
     Sheets(1).Select
     For i = 1 To Sheets.Count
     Sheets(i).Select
     Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False
     ActiveSheet.Paste
[/vba]

((( ну где я ошибся?)) уже сутки решаю эту задачу))
делал все по шагам, в буфере информация хранится, но вставка не происходит
Автор - Мурад
Дата добавления - 18.11.2014 в 10:34
nilem Дата: Вторник, 18.11.2014, 10:49 | Сообщение № 15
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
просто для примера
Предположим есть "Книга2.xlsx" с диапазоном, который нужно скопировать Range("A1:D31") на первом листе, и есть другая книга (в которую нужно копировать) с таким макросом:
[vba]
Код
Sub tt()
Dim i&
Workbooks("Книга2.xlsx").Sheets(1).Range("A1:D31").Copy
With ThisWorkbook
     For i = 1 To .Sheets.Count
         With .Sheets(i).Range("A1")
             .PasteSpecial Paste:=xlPasteValues
             .PasteSpecial Paste:=xlPasteColumnWidths
         End With
     Next
End With
Application.CutCopyMode = False
End Sub
[/vba]
Обе книги у нас открыты. Попробуйте

Яндекс.Деньги 4100159601573
 
Ответить
Сообщениепросто для примера
Предположим есть "Книга2.xlsx" с диапазоном, который нужно скопировать Range("A1:D31") на первом листе, и есть другая книга (в которую нужно копировать) с таким макросом:
[vba]
Код
Sub tt()
Dim i&
Workbooks("Книга2.xlsx").Sheets(1).Range("A1:D31").Copy
With ThisWorkbook
     For i = 1 To .Sheets.Count
         With .Sheets(i).Range("A1")
             .PasteSpecial Paste:=xlPasteValues
             .PasteSpecial Paste:=xlPasteColumnWidths
         End With
     Next
End With
Application.CutCopyMode = False
End Sub
[/vba]
Обе книги у нас открыты. Попробуйте
Автор - nilem
Дата добавления - 18.11.2014 в 10:49
Мурад Дата: Вторник, 18.11.2014, 11:26 | Сообщение № 16
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
а в описанном выше примере, вместо вставки значений как вставить данные буфера без потери форматирования?
так:
[vba]
Код
With .Sheets(i).Range("A1")
             .PasteSpecial Paste:=xlPasteColumnWidths
             .Paste
         End With
[/vba]
 
Ответить
Сообщениеа в описанном выше примере, вместо вставки значений как вставить данные буфера без потери форматирования?
так:
[vba]
Код
With .Sheets(i).Range("A1")
             .PasteSpecial Paste:=xlPasteColumnWidths
             .Paste
         End With
[/vba]
Автор - Мурад
Дата добавления - 18.11.2014 в 11:26
nilem Дата: Вторник, 18.11.2014, 11:36 | Сообщение № 17
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
[vba]
Код

With .Sheets(i).Range("A1")
          .PasteSpecial Paste:=xlPasteAll
          .PasteSpecial Paste:=xlPasteColumnWidths
End With
[/vba]

Яндекс.Деньги 4100159601573
 
Ответить
Сообщение[vba]
Код

With .Sheets(i).Range("A1")
          .PasteSpecial Paste:=xlPasteAll
          .PasteSpecial Paste:=xlPasteColumnWidths
End With
[/vba]
Автор - nilem
Дата добавления - 18.11.2014 в 11:36
Мурад Дата: Вторник, 18.11.2014, 12:12 | Сообщение № 18
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
вот все куски, о которых мы говорим:
[vba]
Код
Sub калько()

     Dim i&

     Sheets(1).Select
     For i = 1 To Sheets.Count
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
          
     Workbooks.Open ("экземпляр.xlsx")
     Sheets(1).Select
     Range("A1:D31").Select
     Selection.Copy
      
     With ThisWorkbook
     For i = 1 To .Sheets.Count
        With .Sheets(i).Range("A1")
             .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             .PasteSpecial Paste:=xlPasteAll
        End With
     Next
     End With
     Application.CutCopyMode = False
End Sub
[/vba]

копирование срывается при переходе в другую книгу, т.е. после запуска макроса, в файле "экземпляр" копированный диапазон A1:D31 "не светится". как следствие в нужном файле не происходит вставка
 
Ответить
Сообщениевот все куски, о которых мы говорим:
[vba]
Код
Sub калько()

     Dim i&

     Sheets(1).Select
     For i = 1 To Sheets.Count
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
          
     Workbooks.Open ("экземпляр.xlsx")
     Sheets(1).Select
     Range("A1:D31").Select
     Selection.Copy
      
     With ThisWorkbook
     For i = 1 To .Sheets.Count
        With .Sheets(i).Range("A1")
             .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             .PasteSpecial Paste:=xlPasteAll
        End With
     Next
     End With
     Application.CutCopyMode = False
End Sub
[/vba]

копирование срывается при переходе в другую книгу, т.е. после запуска макроса, в файле "экземпляр" копированный диапазон A1:D31 "не светится". как следствие в нужном файле не происходит вставка
Автор - Мурад
Дата добавления - 18.11.2014 в 12:12
nilem Дата: Вторник, 18.11.2014, 12:38 | Сообщение № 19
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
"не светится" - в смысле муравьи не бегают? :)
У меня вот так работает (предполагается, что обе книги лежат в одной папке)
[vba]
Код
Sub ertert()
Dim i&
With GetObject(ThisWorkbook.Path & "\экземпляр.xlsx")
     .Sheets(1).Range("A1:D31").Copy
     With ThisWorkbook
         For i = 1 To .Sheets.Count
             With .Sheets(i).Range("A1")
                 .PasteSpecial Paste:=xlPasteAll
                 .PasteSpecial Paste:=xlPasteColumnWidths
             End With
         Next
     End With
     Application.CutCopyMode = False
     .Close 0
End With
End Sub
[/vba]

Яндекс.Деньги 4100159601573
 
Ответить
Сообщение"не светится" - в смысле муравьи не бегают? :)
У меня вот так работает (предполагается, что обе книги лежат в одной папке)
[vba]
Код
Sub ertert()
Dim i&
With GetObject(ThisWorkbook.Path & "\экземпляр.xlsx")
     .Sheets(1).Range("A1:D31").Copy
     With ThisWorkbook
         For i = 1 To .Sheets.Count
             With .Sheets(i).Range("A1")
                 .PasteSpecial Paste:=xlPasteAll
                 .PasteSpecial Paste:=xlPasteColumnWidths
             End With
         Next
     End With
     Application.CutCopyMode = False
     .Close 0
End With
End Sub
[/vba]
Автор - nilem
Дата добавления - 18.11.2014 в 12:38
Мурад Дата: Вторник, 18.11.2014, 16:14 | Сообщение № 20
Группа: Проверенные
Ранг: Ветеран
Сообщений: 513
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
все равно не получилось автоматизировать сразу все. в итоге сделал 2 макроса.

первый макрос раздвигает строки на каждом листе:
[vba]
Код
Sub Строки()
     Dim i&
     Sheets(1).Select
     For i = 1 To Sheets.Count
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
     Sheets.Select    
End Sub
[/vba]

затем я вручную копирую из другого файла таблицу, перехожу в нужный мне файл, вставляю ширину столбцов, затем саму таблицу.

после этого запускаю второй макрос, который успешно выполняет расчеты:
[vba]
Код
Sub redakt()
Sheets.Select
Sheets(1).Activate
     Range("D48").Select
     Application.CutCopyMode = False
     ActiveCell.FormulaR1C1 = "1"
     Range("D49").Select
     ActiveCell.FormulaR1C1 = "2"
     Range("D48:D49").Select
     Selection.AutoFill Destination:=Range("D48:D59"), Type:=xlFillDefault
     Range("D48:D59").Select
     Range("A2").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A4").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A5").Select
     Range("A7").Select
     ActiveCell.FormulaR1C1 = "=R[35]C[1]"
     Range("A8").Select
     Range("B15").Select
     ActiveCell.FormulaR1C1 = "=R[33]C"
     Range("B16").Select
     Range("B18").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B19").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B20").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B21").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B22").Select
     ActiveCell.FormulaR1C1 = "=R[28]C"
     Range("B23").Select
     Range("B24").Select
     ActiveCell.FormulaR1C1 = "=R[32]C"
     Range("B25").Select
     ActiveCell.FormulaR1C1 = "=R[27]C+R[28]C+R[29]C+R[30]C"
     Range("B26").Select
     Range("B27").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B28").Select
     Range("A1:D31").Select
     Range("B14:D28").Select
     Selection.NumberFormat = "#,##0.00"
     Range("A1:D31").Select
     Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     Rows("32:42").Select
     Application.CutCopyMode = False
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Range("A1").Select
End Sub
[/vba]

Выводы: я так и не решил проблему автоматизации действий между двумя макросами)))
 
Ответить
Сообщениевсе равно не получилось автоматизировать сразу все. в итоге сделал 2 макроса.

первый макрос раздвигает строки на каждом листе:
[vba]
Код
Sub Строки()
     Dim i&
     Sheets(1).Select
     For i = 1 To Sheets.Count
     Sheets(i).Select
     Rows("1:30").Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     Next i
     Sheets.Select    
End Sub
[/vba]

затем я вручную копирую из другого файла таблицу, перехожу в нужный мне файл, вставляю ширину столбцов, затем саму таблицу.

после этого запускаю второй макрос, который успешно выполняет расчеты:
[vba]
Код
Sub redakt()
Sheets.Select
Sheets(1).Activate
     Range("D48").Select
     Application.CutCopyMode = False
     ActiveCell.FormulaR1C1 = "1"
     Range("D49").Select
     ActiveCell.FormulaR1C1 = "2"
     Range("D48:D49").Select
     Selection.AutoFill Destination:=Range("D48:D59"), Type:=xlFillDefault
     Range("D48:D59").Select
     Range("A2").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A4").Select
     ActiveCell.FormulaR1C1 = "=R[39]C[1]"
     Range("A5").Select
     Range("A7").Select
     ActiveCell.FormulaR1C1 = "=R[35]C[1]"
     Range("A8").Select
     Range("B15").Select
     ActiveCell.FormulaR1C1 = "=R[33]C"
     Range("B16").Select
     Range("B18").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B19").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B20").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B21").Select
     ActiveCell.FormulaR1C1 = "=R[38]C"
     Range("B22").Select
     ActiveCell.FormulaR1C1 = "=R[28]C"
     Range("B23").Select
     Range("B24").Select
     ActiveCell.FormulaR1C1 = "=R[32]C"
     Range("B25").Select
     ActiveCell.FormulaR1C1 = "=R[27]C+R[28]C+R[29]C+R[30]C"
     Range("B26").Select
     Range("B27").Select
     ActiveCell.FormulaR1C1 = "=R[31]C"
     Range("B28").Select
     Range("A1:D31").Select
     Range("B14:D28").Select
     Selection.NumberFormat = "#,##0.00"
     Range("A1:D31").Select
     Selection.Copy
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
     Rows("32:42").Select
     Application.CutCopyMode = False
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Selection.Delete Shift:=xlUp
     Range("A1").Select
End Sub
[/vba]

Выводы: я так и не решил проблему автоматизации действий между двумя макросами)))
Автор - Мурад
Дата добавления - 18.11.2014 в 16:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос_калькуляция стоимости (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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