Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Здравствуйте.
Помогите пожалуйста с макросом экспорта в Excel, который бы переносил, при превышении кол-ва строк 1048576,
строки на следующий лист.
Нашел такую ссылку Qlikview to excel export macro
P.s. Чтобы работало, то указано в ссылке, файл Excel должен существовать. Там добавление строк, попробовал на 3 мил. не дождался, прибил процесс, очевидно тупиковый путь вставлять построчно.
Попробуй этот макрос. И замени только Месяц на свое измерение (Месяц-Год)
sub Export
set obj = ActiveDocument.GetSheetObject("CH07")
set vMonths = ActiveDocument.Fields("Месяц").GetPossibleValues
set objExcel = CreateObject("Excel.Application")
objExcel.Visible = false
objExcel.DisplayAlerts = false
set objWrkBk = objExcel.Workbooks.Add
i = objWrkBk.Worksheets.Count
Do Until i = 1
objWrkBk.Worksheets(i).Delete
i = i - 1
Loop
For i = 0 to vMonths.Count -1
objWrkBk.Sheets.Add(, objWrkBk.Sheets(objWrkBk.Sheets.Count)).Name = vMonths(i).Text
ActiveDocument.Fields("Месяц").Select vMonths(i).Text
Set ASheet = objExcel.Sheets(vMonths(i).Text)
ASheet.Range("A1").Select
obj.CopyTableToClipboard true
ASheet.Paste
Next
For i = 0 to vMonths.Count -2
ActiveDocument.Fields("Месяц").ToggleSelect vMonths(i).Text
Next
objWrkBk.Sheets(1).Delete
ASheet.SaveAs "c:\TEMP\test.xlsx"
objExcel.Quit
end sub
Добрый день, Иван. Обычный .CopyTableToClipboard .Paste не подойдет. Ниже вариант макроса которым я не пользовался, но возможно он поможет решить данный вопрос.
Sub ExcelAppend (PFM)
SET objExcelApp = CREATEOBJECT("Excel.Application")
objExcelApp.DefaultSaveFormat = xlWorkbookNormal
objExcelApp.Workbooks.Open Template
SET objExcelSheet = objExcelApp.Worksheets(1)
SET objObjectFrom = ActiveDocument.GetSheetObject("TB01")
MaxColumn = objObjectFrom.GetColumnCount
MaxRow = objObjectFrom.GetRowCount
FOR intObjectRow = 1 To MaxRow - 1
FOR intObjectColumn = 0 To MaxColumn - 1
SET objCell = objObjectFrom.GetCell(intObjectRow, intObjectColumn)
objExcelSheet.Cells(intObjectRow+20,intObjectColumn+2) = objCell.Text
NEXT
objExcelSheet.Cells(intObjectRow+20,1).Value = intObjectRow
NEXT
objExcelApp.DisplayAlerts = False
objExcelSheet.SaveAs DirPFM
objExcelApp.Application.Quit
SET objExcelSheet = NOTHING
SET objExcelApp = NOTHING
END SUB
Простой подход не позволит вставить более чем 1 048 576 строк. Нужно разбросать по листам, чтобы обойти ограничение на лист. Например есть в таблице 3,5 мил.строк, нужно на 1 лист Excel экспортировать с 1 по 1 000 000, на второй с 1 000 001 по 2 000 000, на 3 лист с 2 000 001 по 3 000 000 и на 4-ый оставшиеся строки.
А что у Вас в PFM отдавать?
Я думаю, Иван, подходящих вариантов для решения данного вопроса не видать. А макрос, что я скидывал - то же самое, что позднее было в ссылке Qlikview to excel export macro . Скорее всего, надо искать что-то другое. Вообще работать с excel-ем в 3 млн строк крайне неудобно. Может сразу писать в sql?
Тогда видится другой вариант.
Выгружать по измерению, есть месяц. Раскидать 3,5 мил. на 12 месяцев, надеясь, что один месяц не превысит 1048576.
вариант 1
Только в этом макросе на измерение создается отдельный файл, а нужно лист.
Если такой вариант устравивает, надо воспользоваться. А то, что раскидывает по разным файлам а не листам, вопрос 15 минут. Если есть желание, вечерком могу глянуть.
Посмотрите пожалуйста. Экспорт в один файл с перезаписыванием, листы по измерению Лист_Месяц-Год с сортировкой и снятием фильтра после перебора, а то в примере выше по ссылке остается.
Еще 2 вопроса, как обычно добавляют
1. После названий столбцов, отдельной строкой номера столбцов
2. Номер строки по порядку добавляют в таблицу или при экспорте
Глянул макрос, честно говоря, это не совсем то, о чем говорили, но потом посмотрю. Нумерация столбов и строк зачем? Если она нужна, то можно и в таблице но проще после экспорта макросом проставить, но это отдельная тема.
Попробуй этот макрос. И замени только Месяц на свое измерение (Месяц-Год)
sub Export
set obj = ActiveDocument.GetSheetObject("CH07")
set vMonths = ActiveDocument.Fields("Месяц").GetPossibleValues
set objExcel = CreateObject("Excel.Application")
objExcel.Visible = false
objExcel.DisplayAlerts = false
set objWrkBk = objExcel.Workbooks.Add
i = objWrkBk.Worksheets.Count
Do Until i = 1
objWrkBk.Worksheets(i).Delete
i = i - 1
Loop
For i = 0 to vMonths.Count -1
objWrkBk.Sheets.Add(, objWrkBk.Sheets(objWrkBk.Sheets.Count)).Name = vMonths(i).Text
ActiveDocument.Fields("Месяц").Select vMonths(i).Text
Set ASheet = objExcel.Sheets(vMonths(i).Text)
ASheet.Range("A1").Select
obj.CopyTableToClipboard true
ASheet.Paste
Next
For i = 0 to vMonths.Count -2
ActiveDocument.Fields("Месяц").ToggleSelect vMonths(i).Text
Next
objWrkBk.Sheets(1).Delete
ASheet.SaveAs "c:\TEMP\test.xlsx"
objExcel.Quit
end sub
Что то не работает. Приложил пример
p.s. Чего по подумал, если вывести поле cel(rown/1000000) то это и будет изначальный вариант