макрос для расчета и записи в двумерный массив, после вставки массива на лист

Автор Underrating, 4 мая 2017, 13:39

0 Пользователи и 1 гость просматривают эту тему.

Underrating

Добрый день! Помогите написать макрос для записи таблицы умножения, ниже есть пример как записываю в каждую ячейку отдельно. Но работает он слишком долго, поэтому сне надо сначала сохранить все в Базу Data а после из базы вставить на лист.


Работающий код требующий доработки

Sub twoset
Dim Doc As Object
Dim Sheet As Object
Doc = ThisComponent
Sheet = Doc.Sheets(13)
for i=14 to 91 step 1
for j=3 to 80 step 1
m=Sheet.getcellbyposition(13,j).value
n=Sheet.getcellbyposition(i,2).value
ThisWorkBook.Sheets(14).Cells(j+1,i+1)=m*n   
next
next


End Sub


Изменил код но он не работает

Sub twoset
Dim Doc As Object
Dim Sheet As Object
Dim Data as Variant

Doc = ThisComponent
Sheet = Doc.Sheets(13)
Data = Sheet.Range(Sheet.Cells(1, 1), Sheet.Cells(91, 80))
for i=14 to 91 step 1
for j=3 to 80 step 1
m=Sheet.getcellbyposition(13,j).value
n=Sheet.getcellbyposition(i,2).value
Data(j,i)=m*n   
next
next
Sheet.Range(Sheet.Cells(1, 1), Sheet.Cells(91, 80))=Data


End Sub

JohnSUN

Добро пожаловать на форум!
Наверное, имелось в виду что-то в этом роде:
Sub twoSet
Dim oSheets As Variant ' Все листы текущей книги
Dim oSheet As Variant ' Один, рабочий лист (Кстати, почему именно 13-ый?)
Dim oRange As Variant ' Диапазон ячеек с таблицей (включая и заголовки строк/колонок)
Dim oDataArray As Variant ' Все данные этого диапазона
Dim oFrstRow As Variant ' Массив значений из заголовков колонок (первая строка таблицы)
Dim oData As Variant ' Одна строка таблицы (массив)
Dim i&, j& ' Индексы циклов
oSheets = ThisComponent.getSheets()
oSheet = oSheets.getByIndex(13)
oRange = oSheet.getCellRangeByPosition(2, 13, 80, 91) ' Диапазон $C$14:$CC$92. Или нужен другой?
oDataArray = oRange.getDataArray() ' Данные всех ячеек диапазона в массиве массивов
oFrstRow = oDataArray(0) ' Первая строка, значения в заголовках колонок
For i = LBound(oDataArray)+1 To UBound(oDataArray) ' По всем строкам, начиная со второй
oData = oDataArray(i) ' Очередная строка, значение в заголовке строки и результаты
For j = LBound(oData)+1 To UBound(oData) ' По всем ячейкам этой строки, начиная со второй
oData(j) = Val(oData(0)) * Val(oFrstRow(j)) ' Попробуй догадаться, что на что здесь умножается
Next j
oDataArray(i) = oData ' Вернули пересчитанную строку на её место в общем массиве
Next i
oRange.setDataArray(oDataArray) ' Вписали содержимое массива обратно в диапазон на листе
End Sub
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

Underrating

Цитата: JohnSUN от  4 мая 2017, 12:51Добро пожаловать на форум!
Наверное, имелось в виду что-то в этом роде:
Спасибо помогло!
Можно ли усовершенствовать следующую строку
oRange = oSheet.getCellRangeByPosition(2, 13, 80, 91)
вместо 80 и 90 использовать "Dim FinalRow,FinalColumn as integer"

Находим последнюю не пустую строку в 2 колонке
FinalRow = oSheet.Cells(Rows.Count, 2).End(xlUp).Row              'на Excel примено так было бы

Находим последнюю не пустую колонку в 13 строке
FinalColumn = oSheet.Cells(13, Columns.Count).End(xlToLeft).Column        'на Excel примено так было бы


JohnSUN

Можно, всё можно: программирование для того и придумано, чтобы на любой вопрос - любой ответ  ;)
Только сразу поправка - FinalRow (а заодно и FinalColumn) лучше описывать не как Integer, а сразу как Long. Всё-таки сейчас в листе больше миллиона строк - а вдруг номер последней заполненной строки в Integer не поместиться, а?

В местном Бэйсике нет экселевских xlUp/xlToLeft, здесь это делается иначе. Например, так. Дополняем код отдельной функцией:
Function getLast(oSheet as Variant, sCellAddress As String, lastColumn As Boolean) As Long
Dim oCursor As Variant
Dim aRAddress As New com.sun.star.table.CellRangeAddress
oCursor = oSheet.createCursorByRange(oSheet.getCellRangeByName(sCellAddress))
oCursor.collapseToCurrentRegion()
aRAddress = oCursor.getRangeAddress()
If lastColumn Then
getLast = aRAddress.EndColumn
Else
getLast = aRAddress.EndRow
EndIf
End Function
Здесь не сложно, функция создает на листе вокруг ячейки с адресом sCellAddress "курсор" и даёт этому курсору команду "растянись на весь текущий диапазон". Это все равно как стоя на любой ячейке внутри сплошного диапазона нажать Ctrl+*
И в зависимости от значения третьего параметра возвращается или номер последней колонки, или номер последней строки.
Не факт, что это будет именно последняя заполненная ячейка в колонке или в строке. Но уж во всяком случае не меньше, чем нужно.
А начало основной процедуры изменится так:
Dim i&, j& ' Индексы циклов
Dim FinalRow, FinalColumn As Long
oSheets = ThisComponent.getSheets()
oSheet = oSheets.getByIndex(13)
FinalRow = getLast(oSheet, "D14", True)
FinalColumn = getLast(oSheet, "C15", False)
oRange = oSheet.getCellRangeByPosition(2, 13, FinalColumn, FinalRow)
Кстати, эти твои 2 и 13 сбили меня с толку. Речь шла именно о второй колонке? В LibreOffice номер колонки 2 соответствует колонке C, то же и с номерами строк, и с номерами листов - все они нумеруются с нуля.
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

economist

Для таблицы умножения макрос???
Ну тогда такой, простой, быстрый и понятный:  

Option VBASupport 1
Sub Table()
[A1:I9].Formula="=СТРОКА()*СТОЛБЕЦ()"
End sub
Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...