Доброго времени суток! Уважаемые форумчане помогите ускорить работу макроса, либо написать новый. Суть проблемы такова: есть столбец его нужно транспонировать на другой лист по 10 строк либо на этот же лист но с заданного столбца, значения в столбце могут быть дробными так что нужно каким-то образом отключать преобразование в дату.
[vba]
Код
'формирование по 10 строк Sub transposition() Dim intI As Integer Dim intJ As Integer Dim intK As Integer intK = 1 For intJ = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 10 For intI = 0 To 9 Step 1 Selection.NumberFormat = "@" Cells(intK, 2 + intI).Value = Cells(intJ + intI, 1).Value Next intI intK = intK + 1 Next intJ End Sub
[/vba]
Доброго времени суток! Уважаемые форумчане помогите ускорить работу макроса, либо написать новый. Суть проблемы такова: есть столбец его нужно транспонировать на другой лист по 10 строк либо на этот же лист но с заданного столбца, значения в столбце могут быть дробными так что нужно каким-то образом отключать преобразование в дату.
[vba]
Код
'формирование по 10 строк Sub transposition() Dim intI As Integer Dim intJ As Integer Dim intK As Integer intK = 1 For intJ = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 10 For intI = 0 To 9 Step 1 Selection.NumberFormat = "@" Cells(intK, 2 + intI).Value = Cells(intJ + intI, 1).Value Next intI intK = intK + 1 Next intJ End Sub
Файл примера нужен. С листами "Исходное положение" и "Как должно стать". Уже хотя бы для того, чтобы работоспособность этого Вашего макроса проверить.
Чисто умозрительно априори: нужно считать диапазон-источник в массив, перекидать его в другой массив и выгрузить второй массив в диапазон-назначение. Должно быть быстрее, чем поячеечная переброска. Возможно также решение на формулах.
Файл примера нужен. С листами "Исходное положение" и "Как должно стать". Уже хотя бы для того, чтобы работоспособность этого Вашего макроса проверить.
Чисто умозрительно априори: нужно считать диапазон-источник в массив, перекидать его в другой массив и выгрузить второй массив в диапазон-назначение. Должно быть быстрее, чем поячеечная переброска. Возможно также решение на формулах.Gustav
и затем копируем ее в диапазон B1:K43. Далее можно копированием и специальной вставкой оставить в этом диапазоне только значения и подчистить крайние ячейки с 0, в которые превратились пустые ячейки из исходного диапазона. Если это критично,то можно, несколько усложнив формулу, сразу подавить этот эффект.
Наконец, возвращаясь к макросам, можно записать все эти действия макрорекордером и в результате получить новый макрос, который и будет работать быстрее Вашего
Если это реальная задача, а не упражнение именно в макросах, то можно формулой решить. В ячейку B1 вводим формулу:
и затем копируем ее в диапазон B1:K43. Далее можно копированием и специальной вставкой оставить в этом диапазоне только значения и подчистить крайние ячейки с 0, в которые превратились пустые ячейки из исходного диапазона. Если это критично,то можно, несколько усложнив формулу, сразу подавить этот эффект.
Наконец, возвращаясь к макросам, можно записать все эти действия макрорекордером и в результате получить новый макрос, который и будет работать быстрее Вашего Gustav
Задача реальная, вот только хотелось бы без формул, именно макросом. Запись макроса не вариант, так как это часть большого макроса в столбце после неких манипуляций всегда будет находиться разное количество строк, придется опять делать цикл, а хотелось бы уйти от циклов. Думал по поводу массивов, должно работать быстрее. Только вот не знаю как с ними работать.
Задача реальная, вот только хотелось бы без формул, именно макросом. Запись макроса не вариант, так как это часть большого макроса в столбце после неких манипуляций всегда будет находиться разное количество строк, придется опять делать цикл, а хотелось бы уйти от циклов. Думал по поводу массивов, должно работать быстрее. Только вот не знаю как с ними работать.kos-moss
Думал по поводу массивов, должно работать быстрее. Только вот не знаю как с ними работать.
Вот, изучайте. [vba]
Код
'формирование по 10 столбцов Sub transposition_2() Dim arrSrc() As Variant: Dim arrTrg() As Variant Dim rowMax As Long: Dim rowsTrg As Long: Dim colsTrg As Long Dim i As Long: Dim r As Long: Dim c As Long
ReDim arrSrc(1 To rowMax, 1 To 1) ReDim arrTrg(1 To rowsTrg, 1 To colsTrg)
arrSrc = Range(Cells(1, 1), Cells(rowMax, 1)) For i = 1 To rowMax r = Int((i - 1) / colsTrg) + 1 c = i - (r - 1) * colsTrg arrTrg(r, c) = arrSrc(i, 1) Next i With Range("B1").Resize(rowsTrg, colsTrg) .NumberFormat = "@" .Value = arrTrg End With End Sub
[/vba]
P.S. Ну и чисто для пробуждения фантазии - "макро-формульный" вариант: [vba]
Код
Sub transposition_3() Dim rowMax As Long: Dim rowsTrg As Long: Dim colsTrg As Long
With Range("B1").Resize(rowsTrg, colsTrg) .Formula = "=INDEX($A:$A,10*(ROW()-ROW($B$1))+COLUMN()-COLUMN($B$1)+1)" .Copy .PasteSpecial xlPasteValues Application.CutCopyMode = False End With End Sub
Думал по поводу массивов, должно работать быстрее. Только вот не знаю как с ними работать.
Вот, изучайте. [vba]
Код
'формирование по 10 столбцов Sub transposition_2() Dim arrSrc() As Variant: Dim arrTrg() As Variant Dim rowMax As Long: Dim rowsTrg As Long: Dim colsTrg As Long Dim i As Long: Dim r As Long: Dim c As Long
ReDim arrSrc(1 To rowMax, 1 To 1) ReDim arrTrg(1 To rowsTrg, 1 To colsTrg)
arrSrc = Range(Cells(1, 1), Cells(rowMax, 1)) For i = 1 To rowMax r = Int((i - 1) / colsTrg) + 1 c = i - (r - 1) * colsTrg arrTrg(r, c) = arrSrc(i, 1) Next i With Range("B1").Resize(rowsTrg, colsTrg) .NumberFormat = "@" .Value = arrTrg End With End Sub
[/vba]
P.S. Ну и чисто для пробуждения фантазии - "макро-формульный" вариант: [vba]
Код
Sub transposition_3() Dim rowMax As Long: Dim rowsTrg As Long: Dim colsTrg As Long
With Range("B1").Resize(rowsTrg, colsTrg) .Formula = "=INDEX($A:$A,10*(ROW()-ROW($B$1))+COLUMN()-COLUMN($B$1)+1)" .Copy .PasteSpecial xlPasteValues Application.CutCopyMode = False End With End Sub