Вроде как не в курилку, потому что не оффтоп, но вроде как и не вопрос, а просто показать что обнаружил :-)) Если сильно промазал, надеюсь модераторы перенесут.
Какое-то время назад столкнулся с тем, что результат объединения двух или более таблиц и подсчета значений (например суммы колонки) нужно вывести в одну ячейку - и это потянуло за собой необходимость поковырять PowerQuery - что само по себе хорошо, но по сравнению с привычным SQL показалось не очень удобным. Да и толи PQ не умеет возвращать не таблицу, а именно single cell, толи я тупой и не разобрался - в общем задачу то решил, но на протяжении всего процесса было стойкое ощущение нехватки просто возможности написать select sum(field) from table t
Начал гуглить, ничего особо интересного не нашел, кроме каких-то хитрых способов через data connection wizard - показалось не очень удобным.
Попробовал - именно оно, то что и искалось. Возможность прямо в ячейке писать запрос к данным, форматированным как таблица, типа
Код
=Windy.Query("SELECT sum(ID) FROM Таблица1")
Подумал, что может кому-то интересно будет тоже. Да, применимость местами узкая - без надстройки файл с использованием этой функции не передать, работать не будет, но для каких-то локальных вычислений / дел показалось весьма годным.
Не уверен, что названием удалось полностью отразить суть, буду благодарен за любые предложения на что поменять :-)
Есть таблица, которая с помощью макроса разделяется на отдельные воркбуки (точнее в данном случае csv файлы) по уникальным значениям из первой колонки. Собственно, макрос в файле примере, он полностью рабочий и все было бы хорошо :-) Если бы не внезапно обнаруженное ограничение в CRM, которое требует загружать csv с не более чем 1000 строк за раз.
Т.е. по хорошему бы макрос переделать, чтобы если в отфильтрованной таблице содержится более 1000 видимых строк, то макрос сохраняет первую тысячу в файл filename_1.csv, следующую тысячу в filename_2.csv и так далее. На этом мысль и остановилась и наступил жуткий тупняк - не могу придумать, с какой стороны к этому подступиться.
Может быть кто что присоветует.. в аттаче файл с двумя макросами - один наполняет таблицу данными, второй разделяет и складывает csv в папку To Send по тому же пути, где лежит файл.
Спасибо.
--------------- С помощью кофе, гугла и всего такого тупняк прошел. Подумалось, что зачем насиловать таблицу если проще обработать уже полученные файлы. Добавлен макрос split, который смотрит в папку куда генерятся файлы и режет их на части в папку Split которую создает рядом В общем касса отмена
охохо.. попробую написать заново :-) Делал в рамках одной рабочей задачи такую штуку:
Дано: длинная таблица (100-200 тысяч строк) с некоторым количеством колонок и хедером. Чтобы было проще представить - пусть это будет отчет о продажах, где в колонке А расположены уникальные названия магазинов (штук 120), а во всех остальных колонках параметры относящиеся к продаже - номер заказа, дата и так далее.
Задача: разделить эту большую и длинную таблицу на отдельные Excel файлы для каждого магазина. Включая перенос хедера и небольшие косметические операции с каждым файлом - ну типа вставить 4 пустые строки и значение в ячейку дополнительно.
Как сделано:
Код
Option Explicit
Sub split_to_files()
Dim LR As Long, LREMAIL As Long, Itm As Long, MyCount As Long, vCol As Long, sumlr As Long
Dim ws As Worksheet, we As Worksheet, MyArr As Variant, vTitles As String, SvPath As String
Dim docmonth As String, docyear As String, path_f As String, savepath As String, fname As String
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
path_f = ThisWorkbook.Path
savepath = path_f & "\To Send\"
'Sheet with data in it
Set ws = Sheets("main")
'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
vTitles = "A1:G2"
'Choose column to evaluate from, column A = 1, B = 2, etc.
'vCol = Application.InputBox("What column to split data by? " & vbLf _
' & vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
'If vCol = 0 Then Exit Sub
vCol = 1
'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
'Speed up macro execution
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView
'Get a temporary list of unique values from key column
'ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True
ws.Range("A1:A" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True
'Sort the temporary list
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))
'clear temporary worksheet list
ws.Range("EE:EE").clear
'Turn on the autofilter, one column only is all that is needed
ws.Range(vTitles).AutoFilter
'Loop through list one value at a time
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
ws.Range("A1:H" & LR).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Rows(1).Insert Shift:=xlShiftDown
Rows(1).Insert Shift:=xlShiftDown
Rows(1).Insert Shift:=xlShiftDown
Rows(1).Insert Shift:=xlShiftDown
Range("C1").Value = "Additional field:"
Range("C1").Interior.ColorIndex = 6
Cells.Columns.AutoFit
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 5
'MyArr(Itm) = Replace(MyArr(Itm), "/", "")
'MyArr(Itm) = Replace(MyArr(Itm), "\", "")
'MyArr(Itm) = Replace(MyArr(Itm), ":", "")
'MyArr(Itm) = Replace(MyArr(Itm), "=", "")
'MyArr(Itm) = Replace(MyArr(Itm), "*", "")
'MyArr(Itm) = Replace(MyArr(Itm), ".", "")
'MyArr(Itm) = Replace(MyArr(Itm), "?", "")
'MyArr(Itm) = Replace(MyArr(Itm), "{", "")
'MyArr(Itm) = Replace(MyArr(Itm), "}", "")
'MyArr(Itm) = Strings.Trim(MyArr(Itm))
If Dir(savepath, vbDirectory) = "" Then
MkDir savepath
Else
End If
ActiveWorkbook.SaveAs savepath & MyArr(Itm) & ".xlsb", 50 '50 is binary format
ActiveWorkbook.Close False
ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm
'Cleanup
ws.AutoFilterMode = False
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox SecondsElapsed & " Secs for processing"
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False
End Sub
Работает вполне ок, все разделяет, все копирует, нема проблема.
Вопрос: можно ли этот процесс ускорить? Сейчас обработка 1-го файла занимает 1-2 секунд, что в принципе не составляет никаких проблем, интерес чисто академический. Вдруг кто-то сталкивался.
Пример в приложенном файле - там три макроса, один из них чистит документ, второй наполняет его рендомными данными (в колонке А будет 120 уникальных значений), третий собственно делит таблицу на отдельные файлы.
Обычно как-то разбираюсь, а тут столкнулся с задачей и не очень представляю откуда начать копать. Надеюсь, придадите пинок в правильном направлении :-))) Есть Лист1 в котором большая (от 5 до 20-30 тысяч строк, несколько десятков колонок) таблица. Среди колонок есть три - пусть будут SITE ID, SKU, ORDER ID
Сочетания SITE ID + SKU и ORDER ID уникальные, в смысле у сочетания SITE ID и SKU не может быть дублирующхся ORDER ID.
Есть Лист2, в котором есть небольшая табличка SITE ID, SKU, число (обычно от 1 до 10)
Задача: Сгенерировать список ORDER ID согласно табличке на Лист2. Т.е. на вход SITE ID, SKU, 4 - на выход колонка ORDER ID_1 ORDER ID_2 ORDER ID_3 ORDER ID_4
Как они будут взяты - по порядку, рендомно, не важно абсолютно. Просто 4 ORDER ID которые имеют отношение именно к этим SITE ID и SKU.
Т.е. в SQL это было было что-то вроде
Код
SELECT order_id
FROM table
WHERE site_id = 'xxx' AND sku = 'yyy'
limit 4;
Будет это формула или VBA неважно, но всякие PowerQuery ставть наверняка невозможно.
Как думаете, получится что-то? Файл не цепляю, в принципе структура простая, но если надо - сгенерю конечно какую-то демку.