Всем привет! Друзья, помогите ускорить вот этот макрос:
Код
Sub SplitColumn()
'Updateby20141106
Dim rng As Range
Dim InputRng As Range
Dim OutRng As Range
Dim xRow As Integer
Dim xCol As Integer
Dim xArr As Variant
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
xRow = 100
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Cells(InputRng.Row, InputRng.Column).Resize(InputRng.Rows.Count, 1).Interior.Color = 15773696
Set InputRng = InputRng.Columns(1)
xCol = InputRng.Cells.Count / xRow
ReDim xArr(1 To xRow, 1 To xCol + 1)
For i = 0 To InputRng.Cells.Count - 1
xValue = InputRng.Cells(i + 1)
iRow = i Mod xRow
iCol = VBA.Int(i / xRow)
xArr(iRow + 1, iCol + 1) = xValue
Next
OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
End Sub
Он разбивает информацию в одном столбце на табличку из нескольких столбцов, в каждом из которых 100 значений только. В столбце-доноре заполненных ячеек от 600 до 2000 штук. Проблема такая, что при работе нужно выделять полностью столбец (т.е. автоматом вводятся значения, например $A:$A), вписывать вручную или выделять вручную диапазон - не вариант, ещё дольше будет (т.к. столбцов много). И из этой проблемы вытекает следующая: на 1 столбец скрипт выполняется 10 секунд, потому что просчитывает все 1кк строчек в этом столбце. Пробовал вручную выделять диапазон в 600 строк - делает мгновенно
Как сделать так, чтобы макрос вычислял не более 1000 или 2000 строк в столбце? В идеале конечно, чтобы он просчитывал только заполненные ячейки.
Здарова. Если вопрос касается определения заполненного диапазона на листе (или количества строк в заполненном диапазоне, или столбцов, или еще чего) - то давайте: 1. Предложим название темы, отражающее суть задачи. Например: "Определение количества строк в используемом диапазоне на листе". 2. Приложим файл-пример (с данными, строк 10-15) в котором покажем: Вот как есть - вот как нужно. И дополнительно поясним, к примеру - "На самом деле надо обрабатывать не 10-15 строк, а примерно дофига и не 1 столбец, а все, какие найдешь." 3. Совсем хорошо, если сначала полезем в поиск по форму, ибо подобные задачи разбирают тут не то, что часто, а ежедневно просто. Правда, без файла-примера читать код, догадываться в башке куда/зачем/почему это все нужно в бесплатной ветке - ну как-то это негуманно...
Пытливый, начну с пункта 3 Я не знаю vba совершенно, максимум что смог сделать - найти этот код, который частично задачу решает и для оптимизации работы добавить строку с подсветкой "уже обработанного столбца-донора". Искал и на форуме этом и в принципе в гугле, видимо моих познаний не хватает, чтобы правильно сформировать запрос. Т.к. "ограничить число строк в vba" и схожие запросы выдают не то.
Пункт 1. Исходя из пункта 3, описал так, как смог Пункт 2. Файл приложил.
Задача у меня простая: мне нужно обработать 290 столбцов, в файле примере заполнены A-С столбцы, А уже обработан.Это столбцы-доноры. Результат обработки - начинается со столбца J. Столбец А содержит 400 значений и больше, но всегда кратно 100. Мне нужно этот столбец разбить на несколько столбцов по 100 значений в каждом. Каждый последующий столбец добавляется в конец получающейся таблицы, которая начинается с J. По итогу обработки получится длинная таблица из 4-6 столбцов. При работе макроса он спрашивает диапазон - я просто тыкаю на название столбца. Выделять диапазон руками или прописывать его каждый раз - ещё дольше, чем просто 10 секунд подождать, пока макрос работает. Куча времени уходит на то, что макрос из столбца донора обрабататывает ВСЕ ячейки (я уже нагуглил, что всего их больше миллиона), пустые в том числе. Как сделать, чтобы он обрабатывал либо только заполненные, либо только НЕ больше 1000, я не знаю. В параметрах листа если установить видимый диапазон меньше, то пропадает возможность "тыкнуть" на имя столбца. В общем этот метод не сработал.
Roman911, у вас ВООБЩЕ ничего не понятно. Файл-пример нужен для того (сюрприз), чтобы понять "как было" и "как нужно". Вот что я должен понять из такого примера? В столбцах A, B и С нули, а в столбцах, начиная с J - совершенно разные данные…
Цитата
Roman911: Как сделать так, чтобы макрос вычислял не более 1000 или 2000 строк в столбце? В идеале конечно, чтобы он просчитывал только заполненные ячейки.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Не понимаю, какой я тогда файл должен сбросить? Сам скрипт работает так, как нужно. Он просто работает медленно. Как было и как нужно - это выполнение скрипта не 10 секунд, а 1 секунду. Я описал выше, в каком случае это возможно.
Столбец J и далее - это получившаяся таблица из столбца А
Roman911: Сам скрипт работает так, как нужно. Он просто работает медленно.
я не люблю разбираться в таком коде. Код с нуля был бы намного быстрее, понятнее и, может даже, короче. Ну нет так нет - удачи!
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ура-ура, мы почти сформулировали задачу! Надо исходные столбцы по 100 значений напихать в итоговую таблицу. Отсюда сразу вопросы: 1. Итоговая таблица - всегда с J1 начинается, или хотим иметь возможность выбора? 2. Исходные столбцы всегда подряд идут и начинаются с А1, или нужна свобода выбора? 3. Устроит ли вариант волшебной кнопки, при нажатии на которую из исходных столбцов (неважно сколько их будет) будет получаться итоговая таблица начиная с столбца, отстоящего от исходных на 1 пустой столбец? З.Ы. Бонусный вопрос - исходные столбцы с данными содержат одинаковое количество строк?
Roman911, несколько вопросов: 1. Вам нужно именно доработать макрос из #1 или устроит и любой другой, более быстрый? 2. Разбивать именно на 100 строк или эта величина переменная?
Цитата
Roman911 написал: мне нужно обработать 290 столбцов, в файле примере заполнены A-С
3. Следовательно, результат нужно будет выводить уже не в столбец J. А куда? Может на другой лист?
Пытливый, да уж, в предложение уместили то, что реально нужно сделать 1. Не с J1, либо со столбца AW, либо на другом листе 2 Всегда подряд идут, все по 100 значений 3 Это самый лучший вариант
Есть только 1 момент, в исходных столбцах 1-е 100 значений попадают в 1-й столбец итоговой таблицы, 2-е 100 значений попадают во 2-й столбец итоговой таблицы, 3-е 100 значений в 3й столбец и т.д..
Юрий М, 1. Как уже выше ответил Пытливому, да, любой 2. Значения в исходных столбцах по 100 строк идут, да 3. Либо со столбца AW, либо другой лист)
Roman911, благодаря Пытливый стало ясно Макрос берёт ВСЕ данные с листа, убирает пустые, разбивает по 100 и вставляет на новый лист с первой ячейки. Перенести можно ручками…
15 мс на 1 500 данных из примера
Код
Option Explicit
'===========================================================================================
Sub CutColumns()
Dim x, arr, arr1x(), t!, r&, c&
t = Timer
arr = ActiveSheet.UsedRange.Value2
If Not IsArray(arr) Then Exit Sub
ReDim arr1x(UBound(arr, 1) * UBound(arr, 2) - 1)
For Each x In arr
If Len(x) Then arr1x(r) = x: r = r + 1
Next x
If r = 0 Then Exit Sub
ReDim Preserve arr1x(r - 1)
If r > 100 Then
ReDim arr(1 To 100, 1 To Fix(r / 100) + 1)
Else
ReDim arr(1 To r, 1 To 1)
End If
r = 0: c = 1
For Each x In arr1x
r = r + 1: If r = 101 Then r = 1: c = c + 1
arr(r, c) = x
Next x
Application.ScreenUpdating = False
Worksheets.Add After:=ActiveSheet
Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr
Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
MsgBox "Время работы: " & Format$(1000 * (Timer - t), "0 мс"), vbInformation, "ГОТОВО"
End Sub
'===========================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sub T()
Dim arrIn, arrOut, lngI As Long, lngJ As Long, lngK As Long, lngU As Long
Worksheets("Результат").UsedRange.Clear
arrIn = Worksheets("Исходные").Range("a1").CurrentRegion.Value
ReDim arrOut(1 To 100, 1 To UBound(arrIn, 1) / 100 * UBound(arrIn, 2))
For lngJ = 1 To UBound(arrIn, 2)
For lngI = 1 To UBound(arrIn, 1)
If lngU = 100 Then
lngU = 1
Else
lngU = lngU + 1
End If
lngK = WorksheetFunction.RoundUp((lngI + UBound(arrIn) * (lngJ - 1)) / 100, 0)
arrOut(lngU, lngK) = arrIn(lngI, lngJ)
Next lngI
Next lngJ
Worksheets("Результат").Range("A1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)) = arrOut
Worksheets("Результат").Activate
End Sub
Roman911, тут на форуме много добрых людей помогает)) денег не надо - хватит и благодарности, а вот отвечать быстрее (по-возможности, разумеется) было бы не лишним, а то непонятно - видели ли вы решение(-я)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
PS а есть какой способ, объединения получившихся таблиц в одну, последовательно? без копипаста руками, а то вчера скинули материала на 470 столбцов ещё При том, что теперь я точно знаю, что в базе значений всегда 600, т.е. 6 столбцов в итоговой таблице будет
Roman911, создайте новую тему со перекрёстными ссылками (в новой теме на эту, а тут - на новую). Нормальное название темы, файл-пример и описание также обязательны
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄