Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA: Копирование листа в новую книгу
 
#1
21.02.2021 05:25:30
Всем привет
У меня в эксель документе есть таблицы, которые мне нужно копировать в новый документ и сохрнать.(то есть я сгенерировал в Power Query данные) и выгружаю сохраняю как бы кеш.
Данный код работает исправно на маленьких объемах данных, а на больших иногда терминал(я работаю по RDP) зависает из-за объема копирования данных
tbl.Range.Copy - получается эта команда копирует все в буфер и переносит в новый документ.
Вопрос, есть ли оптимальней алгоритм копирования таблицы в новый документ?
Код
Sub csvTable2(lName As String, tName As String, fName As String)
    
    Dim tbl As ListObject
    Set tbl = Worksheets(lName).ListObjects(tName)
    Application.DisplayAlerts = False
    Workbooks.Add
    tbl.Range.Copy Range("A1")
    With ActiveWorkbook
      .SaveAs fName, xlCSV, local:=False
      .Saved = True
      .Close
    End With
    Application.DisplayAlerts = True
    
End Sub
 
 
 
#2
21.02.2021 06:23:53
Попробуйте заменить строчку
Код
Set tbl = Worksheets(lName).ListObjects(tName)
на
Код
Set tbl = Worksheets(lName).ListObjects(tName).usedrange

Вы сохраняете в формате CSV это текстовый файл.С текстовыми файлами Эксель быстрее работает в режиме прямого доступа. Если там есть возможность перенести копируемые данные в массив и потом в режиме прямого доступа напечатать файл методом Print.Я плохо разбираюсь с сетями. На локальном компе так можно
 
 
 
#3
21.02.2021 06:44:50
Vsevolod, по мои тестам копирование 5555 строк через массив аж на одну сотую быстрее
Скрытый текст


Код
Sub csvTable2(lName As String, tName As String, fName As String)
     
    Dim tbl As ListObject
    Set tbl = Worksheets(lName).ListObjects(tName)
    Application.DisplayAlerts = False
    Workbooks.Add

    arr1 = tbl.Range("A1").Value
    Range("A1").Value = arr1

    With ActiveWorkbook
      .SaveAs fName, xlCSV, local:=False
      .Saved = True
      .Close
    End With
    Application.DisplayAlerts = True
     
End Sub
Изменено: wfreedom - 21.02.2021 06:46:16
 
 
 
#4
22.02.2021 09:39:12
Благодарю! wfreedom, Евгений Смирнов,

Попытался модифицировать.
В первом варианте выдает ошибку на
Set tbl = Worksheets(lName).ListObjects(tName).UsedRange

Во втором варианте на
arr1 = tbl.Range("A1").Value

Подскажите, в чем ошибся?
Тестовый пример прицепил
 
 
 
#5
22.02.2021 11:07:34
В модуле процедура csvTable0 новая
Если объет tbl залезет в массив то должно прокатить
Файл не появиться на экране он должен появиться в папке где расположен этот файл
Проверить не начем вы не дали 2 файл с которого копируете
 
 
 
#6
22.02.2021 11:19:06
Цитата
Vsevolod написал:
Подскажите, в чем ошибся?
В вашей ленивости.
Если поглядеть справку, то получится
Код
Set tbl = Worksheets(lName).ListObjects(tName)

arr1 = tbl.Range.Value
 
 
 
#7
22.02.2021 11:55:00
Евгений Смирнов, таблица очень большая( падает overflow:(

RAN, мой уровень VBA очень слаб и пытаюсь разобраться на примерах.
Как я понимаю в arr1 записался объект таблица.
Но вывод срабатывает только первой ячейки A1
Как сделать чтобы весь arr1 в новую таблицу он внес?
Благодарю
Код
arr1 = tbl.Range.Value
Range("A1").Value = arr1
 
 
 
#8
22.02.2021 12:38:31
Цитата
Vsevolod написал:
Как я понимаю в arr1 записался объект таблица.
Нет. Не объект, а ЗНАЧЕНИЯ ячеек, входящих в таблицу.
Для того, чтобы массив выгрузить в диапазон, размер диапазона должен быть равен размеру массива.
 
 
 
#9
22.02.2021 12:44:50
Код
Range("A1").Resize(UBound(arr1, 2), UBound(arr1, 1)).Value = arr1
 
 
 
#10
23.02.2021 09:41:15
Евгений Смирнов, Евгений благодарю, единственное наоборот
Range("A1").Resize(UBound(arr1, 1), UBound(arr1, 2)).Value = arr1

Благодарю всех за помощь, потестируем на больших объемах таблиц
 
 
 
#11
23.02.2021 10:38:33
Цитата
Vsevolod написал:
Копирование листа в новую книгу
Код
Sub Copy2NewBook
  Activesheet.Copy
end sub
все. активный лист скопирован в новую книгу
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#12
23.02.2021 10:44:26
Ігор Гончаренко, когда ты работаешь по RDP в терминале, у тебя он зависает на огромных таблицах. Потому что буфер обмена прилетает по RDP

Поэтому от copy отказываемся на больших таблицах
 
 
 
#13
23.02.2021 10:48:47
а что это такое RDP и терминал?
и зачем мне в них работать???
Изменено: Ігор Гончаренко - 23.02.2021 10:49:17
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#14
23.02.2021 17:32:49
Vsevolod
Да вы правы с размерностью ошибся.
поторопился
 
 
 
#15
21.03.2021 07:55:53
Вот какая проблема всплыла:(

В исходной таблице в ячейка задано ТЕКСТОВЫМ ТИПОМ значение 1000006707215
При копировании кодом ниже - он сохраняет в CSV формате значение 1.00001E+12
Подскажимте, можно задать как-то, чтобы он не делал такие преобразования?
Благодарю!
Код
Sub csvTable2(lName As String, tName As String, fName As String)

Dim tbl As ListObject
Set tbl = ThisWorkbook.Worksheets(lName).ListObjects(tName)
Application.DisplayAlerts = False
Workbooks.Add
Set wb = ActiveWorkbook

arr1 = tbl.Range.Value
Range("A1").Resize(UBound(arr1, 1), UBound(arr1, 2)).Value = arr1

With ActiveWorkbook
.SaveAs fName, xlCSV, local:=False
.Saved = True
.Close
End With
Application.DisplayAlerts = True

End Sub
Изменено: Vsevolod - 21.03.2021 07:57:28
 
 
 
#16
21.03.2021 08:18:05
Цитата
Vsevolod написал:
он сохраняет в CSV формате значение 1.00001E+12
А какое это имеет отношение к
Цитата
VBA: Копирование листа в новую книгу
:qstn:
P. S. И не забудьте в новой теме приложить доказательства :)
Изменено: Андрей VG - 21.03.2021 08:21:17
 
 
 
#17
21.03.2021 08:44:19
Цитата
Vsevolod написал:
у тебя он зависает на огромных таблицах. Потому что буфер обмена прилетает по RDP
Бред, точнее если копировать в буфер, а с точки зрения безопасности он должен быть запрещен, то оно верно, а то что написал Игорь не задействует его. Копируется лист. Копируется на той скорости которая доступна для конкретного ПК  скорость зависит от объема.

простейший тест
Код
Sub test()
Debug.Print [a1].Formula
Debug.print ActiveSheet.UsedRange.Address
t = Timer
ActiveSheet.Copy
Debug.Print Timer - t
End Sub

массив A:M с формулой

RDP  виртуалка на 2 ядра (Буфер обмена разрешен)
=ROW()*COLUMN()
$A:$M
30,86719

RDP  физическая старенький I7 (Буфер обмена разрешен)
=ROW()*COLUMN()
$A:$M
11,95117

физическая старенький I5 ноутбук
=ROW()*COLUMN()
$A:$M
16,43555
По вопросам из тем форума, личку не читаю.
 
 
 
#18
21.03.2021 10:32:56
Андрей VG, Понял, открою новый вопрос. Просто мне изначально в этом  решение предлагали.

БМВ, у меня виснет RDP при больших объемах копирования:( Черный экран и все
 
 
 
#19
21.03.2021 10:44:53
Цитата
Vsevolod написал:
виснет RDP при больших объемах копирования
Виснет не RDP, а скорее всего на это время RDP хост не справляется по ресурсам.
По вопросам из тем форума, личку не читаю.
 
 
 
Страницы: 1
Наверх