Очистка буфера обмена

Пользователь

Сообщений: 303 Регистрация: 01.01.1970

Ternov

15.11.2010 15:01:53

Добрый день. Пишу макрос - немогу разобраться как заставить буфер обмена очишаться перед включением макроса. Я искал на форуме и кроме http://www.programmersforum.ru/showpost.php?p=154621&postcount=4
- не нашел - но это почемуто не помогает...
Вот код помогите вставить его правильно, а еще я не понял что такое "user32"

Sub KPI_9()
' KPI_9 Макрос
' Расходы_департамента безопастности
Application.ScreenUpdating = False
' Путь
Workbooks.Open Filename:= _
"http://srv-portal/sites/fin/budg/PL/Безопасность%20и%20Фрод/Расходы_ДБ.xlsx", _
UpdateLinks:=0
' Киров (КИР)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("КИР").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A103").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SelectedSheets.Visible = False
' Скрыть лист
Windows("Расходы_ДБ.xlsx").Activate
ActiveWindow.Close False
' Закрыт без сохранения (если закрыть с сохранением то ActiveWorkbook.Saved = True)
Windows("Base of PL.xlsm").Activate
Sheets("Главная").Select
Application.ScreenUpdating = True
End Sub

Заранее благодарю!

Guest Гость	#2 15.11.2010 15:19:11 А эта тема не поможет? http://www.planetaexcel.ru/forum.php?thread_id=6307

Казанский Пользователь Сообщений: 8839 Регистрация: 11.01.2013	#3 15.11.2010 15:24:23 Еще можно скопировать пустую ячейку: cells.SpecialCells (xlCellTypeLastCell)(2).copy

EducatedFool

Пользователь

Сообщений: 3697 Регистрация: 23.12.2012

15.11.2010 16:02:11

Чтобы не чистить буфер обмена - может, попробовать его просто не использовать?

Sub KPI_9() ' Расходы_департамента безопастности
Application.ScreenUpdating = False
Dim Base_of_PL As Workbook: Set Base_of_PL = ActiveWorkbook ' текущая книга

Ссылка = "http://srv-portal/sites/fin/budg/PL/Безопасность%20и%20Фрод/Расходы_ДБ.xlsx"
Dim Расходы_ДБ As Workbook: Set Расходы_ДБ = Workbooks.Open(Ссылка, 0)

Диапазон = "A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14"
' копируем (не через буфер обмена)
Расходы_ДБ.Worksheets("КИР").Range(Диапазон).Copy Base_of_PL.Worksheets("9").Range("A103")

Расходы_ДБ.Close False ' закрываем без сохранения
Base_of_PL.Sheets("Главная").Activate
End Sub

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

ternovsky

Пользователь

Сообщений: 303 Регистрация: 01.01.1970

Ternov

16.11.2010 06:51:31

EducatedFool - спасибо за ваш ответ, попровал - действует, но он переносит не только значения но и форматы. (т.к. у меня более 150тыс. значений будет копироваться с разных листов - я бы хотел по максимуму оптимизировать "вес" и поэтому даже лишняя запятая или подкрашенная ячейка - это доп. "вес")

Попробовал вариант Казанского - работает, думаю это лучший вариант в моем случае! Большое вам спасибо уважаемые эксперты.

Hugo Пользователь Сообщений: 26486 Регистрация: 22.12.2012	#6 16.11.2010 09:53:43 Быстро и без лишней информации (и без буфера) можно копировать через массив. Только здесь вероятно или через много массивов, или через один много раз. Что-то вроде Sub tt() Dim a a = [a1:b10] [e1:f10] = a End Sub

Guest

Гость

16.11.2010 10:03:47

{quote}{login=Hugo}{date=16.11.2010 09:53}{thema=}{post}Быстро и без лишней информации (и без буфера) можно копировать через массив.
Только здесь вероятно или через много массивов, или через один много раз.
Что-то вроде

Sub tt()
Dim a
a = [a1:b10]
[e1:f10] = a
End Sub{/post}{/quote}

Как этоприменить к моему макросу, если поможите сократить - буду оч. признателен
Вот полный код:
Sub KPI_9()
' KPI_9 Макрос
' Расходы_департамента безопастности
Application.ScreenUpdating = False
Application.StatusBar = "Подождите, выполняется обновление данных..."
' Путь
Workbooks.Open Filename:= _
"http://srv-portal/sites/fin/budg/PL/Безопасность%20и%20Фрод/Расходы_ДБ.xlsx", _
UpdateLinks:=0

' УРАЛ (УРАЛ)со строки 3 (7 строк ) конец 9 строка
Windows("Расходы_ДБ.xlsx").Activate
Sheets("УРАЛ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Visible = True
'Отобразить лист
Sheets("9").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Екатеринбург (ЕКБ)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("ЕКБ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Челябинск (ЧЛБ)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("ЧЛБ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Курган (КУРГ)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("КУРГ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' ХМАО (ХМАО)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("ХМАО").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' ЯНАО (ЯНАО)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("ЯНАО").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A53").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Пермь (ПРМ)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("ПРМ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A63").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Тюмень (ТМН)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("ТМН").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A73").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' КОМИ (КОМИ)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("КОМИ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A83").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Удмуртия (УДМ)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("УДМ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A93").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Киров (КИР)
Windows("Расходы_ДБ.xlsx").Activate
Sheets("КИР").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Select
Range("A103").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Cells.SpecialCells(xlCellTypeLastCell)(2).Copy
' скопировать пустую ячейку

ActiveWindow.SelectedSheets.Visible = False
' Скрыть лист
Windows("Расходы_ДБ.xlsx").Activate
ActiveWindow.Close False
' Закрыт без сохранения (если закрыть с сохранением то ActiveWorkbook.Saved = True)
Windows("Base of PL.xlsm").Activate
Sheets("Главная").Select
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Данные обновлены!"

End Sub

Guest

Гость

16.11.2010 10:08:32

Этот макрос - сылается на книгу которая лежит на портале, в этой книге есть вкладки УРАЛ, ЕКБ, и т.д. 11 регионов - макрос сначала открывает книгу, далее выбирает диапазон и копирует только значения через спец. вставку. далее открывает след лист с регионом и повторяет операцию...

Как этот длинный код заменить на более короткий или оптимизировать, но с сохранением тех же функций.? или это норм вариант? - как есть...

Hugo

Пользователь

Сообщений: 26486 Регистрация: 22.12.2012

16.11.2010 10:19:25

Не, ну всё я не потяну :)

Примерно так думаю:
Sub tt()
Sheets("УРАЛ").Select
Range("A3:N3,A7:N7,A10:N14,P3:AA3,P7:AA7,P10:AA14,AC3:AN3,AC7:AN7,AC10:AN14").Select
Selection.Copy
Windows("Base of PL.xlsm").Activate
Sheets("9").Visible = True
'Отобразить лист
Sheets("9").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Sub ttt()
Dim a
a = Sheets("УРАЛ").[a3:n3]
Sheets("9").[a3:n3] = a
End Sub

tt меняем на ttt, но конечно это схематично - надо части диапазона копировать отдельно, ещё нужно указать файл, где Sheets("9") находится. И нужно точно просчитать, куда выгружаем массивы, хотя бы первую ячейку каждого, далее можно через Resize Ubound, типа:
sh1.[a3].Resize(UBound(Arr2, 1), UBound(Arr2, 2)).Value = Arr2 'выгружаем результат

ternovsky Пользователь Сообщений: 303 Регистрация: 01.01.1970 Ternov	#10 16.11.2010 11:34:52 Прист - оч странно, при копировании он следует по порядку... Копирует урал и т.д. доходит до конца и потом снова возврашается на урал и вставляет туда значения "Кир"

ternovsky Пользователь Сообщений: 303 Регистрация: 01.01.1970 Ternov	#11 16.11.2010 11:46:12 спасибо! Всем большое спасибо!!

Читают тему