Здравствуйте!
Прикреплённый файл - таблица с показаниями температур за 2012-2014 (по сей день) год. Мне необходимо создать макрос, который удалил бы все строки за исключением тех, время которым соответствует либо
12:00 либо 16:00. Затем, на основе полученных данных, макрос должен в первом столбце оставить только дату (время удалить) вида "YYYY-MM-DD" и соединить строки (по две штуки) друг с другом, высчитывая
среднюю между температурами. Возможно ли такое?
Я пробовал писать макрос для удаления. Получилось следующее:
Option Explicit
Sub Macro1
Dim j, i as integer
Dim Doc, Sheet as object
j = 0
Doc = StarDesktop.CurrentComponent
Sheet = Doc.CurrentController.ActiveSheet
For i = 1 to 8347
If j >= 2 and j <= 8 Then
Sheet.Rows.removeByIndex(i, 1)
End If
If j = 8 Then
j = 0
Else
j = j + 1
End If
Next i
После использования макроса получился какой-то бардак - не то, что я ожидал....
Зря, наверное, из Calc'а сюда убежал... Есть мнение, что без макроса, одними встроенными функциями Calc'а задача решается очень быстро.
Может она и есть - но я не нашёл её.
Попробуй макрос :D
2 условия на входные данные:
1) в столбце температуры заменить "." на ",". По крайней мере у меня в ОС разделить целой и дробной части ","
2) в файле должен быть лист с названием "Sheet"
sub Cos
dim oSheet as object
dim oDoc as object
dim myrows as object
dim i,j,k as integer
oDoc = thisComponent
oSheet = oDoc.getCurrentController.getActiveSheet
myrows=oSheet.getrows
oSheet.GetCellRangeByName("C1").string = "Проверка на время"
oSheet.GetCellRangeByName("E1").string = "Дата"
oSheet.GetCellRangeByName("F1").string = "Средняя температура"
oSheet.GetCellRangeByName("G1").string = "Количество дат"
r = oSheet.GetCellRangeByName("A1").getValue()
i = 1
do while r <> ""
r = oSheet.GetCellRangeByName("A"&i).string
oSheet.GetCellRangeByName("c"&i).formula = "=IFERROR(FIND("+CHR$(34)+"16:00"+CHR$(34)+":a"& i &");iferror(find("+CHR$(34)+"12:00"+CHR$(34)+";a"& i &");0))"
oSheet.GetCellRangeByName("E"&i).formula = "=left(A" & i &"; 10)"
oSheet.GetCellRangeByName("F"&i).formula = "=AVERAGEIF(e1:e9000;E" & i & ";B1:B9000)"
oSheet.GetCellRangeByName("G"&i).formula = "=countif(e1:e"& i &";E"& i &")"
if oSheet.GetCellRangeByName("c"&i).getValue() = 0 then
myrows.removebyindex(i-1,1)
i = i - 1
end if
i = i + 1
loop
Sheet1 = oDoc.Sheets.getByName("Sheet")
Sheet1.GetCellRangeByName("a1").string = "Дата"
Sheet1.GetCellRangeByName("b1").string = "Средняя температура"
k = 0
for j = 1 to i
if oSheet.GetCellRangeByName("G"&j).getValue() = 1 then
k = k + 1
Sheet1.getcellrangebyname("A"& k).string = oSheet.GetCellRangeByName("E" & j).string
Sheet1.getcellrangebyname("B"& k).string = oSheet.GetCellRangeByName("F" & j).string
end if
next j
end sub
p.s. только на 9k записей долго уж будет считать :P
Цитата: Aleksandr H. от 13 ноября 2014, 22:20Попробуй макрос :D
Что-то никого не видно на форуме ???, наверно, пробуют макрос...
Да нет, уже распробовали... Теперь в засаде сидим, ждём интересных вопросов.
Цитата: Aleksandr H. от 13 ноября 2014, 22:20p.s. только на 9k записей долго уж будет считать
Не то слово. Надоело на первой сотне. ;D
Мне 5 сек больше нравится. А лучше 2.
А, ну да... Поругать-то каждый мастак! А советом помочь? "Делай как я!.." (с) Б.Титомир
Aleksandr H., друг мой, есть несколько соображений, как избавиться от этих проблем:
Цитата: Aleksandr H. от 14 ноября 2014, 00:20
2 условия на входные данные:
1) в столбце температуры заменить "." на ",". По крайней мере у меня в ОС разделить целой и дробной части ","
2) в файле должен быть лист с названием "Sheet"
3) только на 9k записей долго уж будет считать :P
1) мог бы сделать и сам, раз уж данные достались в таком виде. Вот так вот сходу вижу три способа:
а) если решил работать с формулами, то что-то вроде
=VALUE(SUBSTITUTE(B11;".";","))отлично преобразует неправильные строки в правильные числа
б) в том же цикле, где перебираешь строки, можно было бы одновременно подменять значения в ячейках на результат функции VAL() - ей разделитель дробной части "точка" как раз очень нравится
в) поиск и замена по этой колонке дала бы тот же результат, и гораздо быстрее, а в макросе это заняло бы не больше шести строчек
oColumn = oSheet.getColumns().getByIndex(1) ' Получили вторую колонку целиком
oRplDsc = oColumn.createReplaceDescriptor() ' Создали для неё дескриптор замены
oRplDsc.setSearchString(".") ' Искать точку
oRplDsc.setReplaceString(",") ' Менять на запятую
oColumn.replaceAll(oRplDsc) ' Фас!О, даже пять, если не устанавливать SearchRegularExpression
2) и здесь мог бы сделать сам - у объекта Sheets есть хорошие методы hasByName("Sheet") (уже есть такой лист?) и insertNewByName("Sheet", 0) (вставить новый лист с вот таким именем в вот такую позицию). Это добавило бы в макрос всего один If...Then
3) Посчитает-то Calc это всё очень быстро, долго идет заполнение ячейка за ячейкой. И здесь тоже есть куча возможностей сделать всё быстро:
а) прежде всего - количество данных на листе: перебирать все строки, пока не доберёшся до пустой ячейки, это очень медленно и очень не надёжно. А вдруг посреди таблицы с данными попадётся случайно такая ячейка? Лучше использовать приём, который задействован в функции GetLastUsedRow (библиотека Tools, модуль Misc) - для листа создаётся курсор, ему даёшь команду GotoEndOfUsedArea и тут же узнаёшь последнюю строку и последнюю колонку с данными.
б) для получения ячеек или диапазонов лучше использовать методы ByIndex, а не ByName - это гораздо быстрее: Basic'у не придётся самому вычислять номер строки и столбца для, скажем, "F1" или "G"&i
в) вложенный =IFERROR(FIND("16:00":A47);IFERROR(FIND("12:00";A47);0)) - хорошая находка, но... Ты, видимо, как и
RAN прозевал поправку (http://forumooo.ru/index.php/topic,4605.msg28336.html#msg28336):там не 16:00, а 15:00. Да и формула =ISNUMBER(FIND(RIGHT(A47;5);"12:00 15:00")) выглядит короче, хоть и даёт тот же результат.
г) вписывание формул в колонки E, F и G в большинстве случаев будет лишним - ты же сейчас эту строку удалишь, так зачем что-то туда писать? Лучше бы перенести эти действия в ветку ELSE - не удаляем строку, значит пишем формулы
д) само удаление строк - операция, наверное, и не очень-то нужная. Нет, я понимаю, что автор вопроса именно об этом просил, но раз уж результат будет опубликован на отдельном листе, то с листа с исходными данными можно было бы строки и не удалять - это намного ускорило бы процесс. Кстати, обычно если внутри цикла есть удаление элементов, то принято строить цикл "задом наперед", снизу вверх. Тогда в случае удаления не приходится играться с индексом, то вычитать единичку, то опять прибавлять.
е) размножение формул тоже можно было бы сделать очень быстро. Для этого у диапазонов ячеек есть специальный метод fillAuto - вписываешь формулы только в одну строку, определяешь диапазон, так чтобы эта строка в нем была первой и вызываешь fillAuto: щелк и все формулы внесены и посчитаны.
А вообще, молодец! Да, долго... Но результат-то именно тот, что и просили!
JohnSUN , спасибо за поддержку!
Мои комментарии: Конечно я мог сделать замену точки на запятую и добавить новый лист 8-). Для 1 пункта тоже думал сделать через формулу, но не через VALUE а с помощью IFов б обыграл возникновение ошибки. Но твой вариант (в), имхо, оптимальный. Только я, к своему стыду, ваашпе не ориентируюсь что такое дескрипторы и какие они бывают. :-[
Пункт 2. Признаюсь, поленился поискать как вставить новый лист. Только, о5 же, я не знал про метод
hasByName("Sheet"), я б в гугле писал "open office basic перебрать листы scalc", узнал как перебрать в листы и в цикле смотрел на имена листов не встречается ли там "SHEET". :roll:
Пункт 3.
ЦитироватьЛучше использовать приём, который задействован в функции GetLastUsedRow (библиотека Tools, модуль Misc) - для листа создаётся курсор, ему даёшь команду GotoEndOfUsedArea и тут же узнаёшь последнюю строку и последнюю колонку с данными.
Да, ты мне показывал как использовать GetLastUsedRow и правильно было б её использовать, только на пару милисекунд после мысли про GetLastUsedRow пришла мысля "Да ну, эти данные это результат какого-то запроса, не может быть пустой ячейки". Каюсь :)
ByIndex легче Basic'y, a ByName легче для меня ;-) (ааааа. страшная фраза "создаётся курсор")
=ISNUMBER(FIND(RIGHT(A47;5);"12:00 15:00")) это разрыв шаблона, атака с тыла :-)
ЦитироватьКстати, обычно если внутри цикла есть удаление элементов, то принято строить цикл "задом наперед", снизу вверх.
Не знал, постараюсь запомнить. Вот здесь б и использовалась функция GetLastUsedRow ;-)
Цитироватьспециальный метод fillAuto - вписываешь формулы только в одну строку, определяешь диапазон, так чтобы эта строка в нем была первой и вызываешь fillAuto: щелк и все формулы внесены и посчитаны.
Не знал.
Вообще много чего не знаю. Почти каждый интересующий момент ищу в Интернете. Туториала б хорошего :-[
Итог, наваял индусского ненужного кода, а вы в параллельной ветке так изящно оформили все. Как говорит коллега "Важко в світі жити безтолковому" :D
Цитата: Aleksandr H. от 14 ноября 2014, 22:20
Только я, к своему стыду, ваашпе не ориентируюсь что такое дескрипторы и какие они бывают. :-[
"Спокойствие, только спокойствие!"(с)Карлсон
Нам ли бояться каких-то там дескрипторов? Мы же мегакруты, мы знаем каратэ, джиу-джитсу, кунг-фу и ещё кучу страшных слов!
Слово "дескриптор" выглядит так погано потому что для него не придумали хорошего перевода. А на самом-то деле штука очень простая.
Вот нажми Ctrl+H и попробуй выписать в столбик все поля и флажки, которые в этой форме видишь:
Найти - строка поиска - умолчания нет
Заменить на - строка замены - по умолчанию пустая строка (менять на "ничто")
Учитывать регистр - флажок (логическое) - по умолчанию "Нет"
Ячейку целиком - флажок (логическое) - по умолчанию "Нет"
Регулярные выражения - - флажок (логическое) - по умолчанию "Нет" и так далееВот весь этот набор параметров поиска/замены, собранный в одну кучу (в одну структуру, в одну запись, в один объект), и дополненный несколькими методами типа getSearchString или setReplaceString - это и есть "дескриптор" ("описатель" - ударение на "а"). Для чего эта беда придумана? А просто чтобы вызывать findAll или replaceAll всего с одним параметром. Знаешь как в VBA выглядит вызов Replace? А вот так:
expression.Replace(What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte, SearchFormat, ReplaceFormat)Так чтобы вот так же через запятую не перечислять всё что нужно и не нужно - создаем запись-дескриптор, отдельными присваиваниями меняем только те значения, которые нужны не "умолчальные", и запускаем поиск или замену, указав в качестве параметра одну переменную, в которую упаковано всё что может потребоваться...
Всё это довольно просто. Самое сложное - придумать нормальное слово, которое передавало бы смысл всех этих действий. Не придумали пока, оставили "дескриптором", людей пугают...
Цитата: Aleksandr H. от 14 ноября 2014, 22:20
ByIndex легче Basic'y, a ByName легче для меня ;-)
Ну, не знаю, дело хозяйское... Но когда я запускаю макрос, в котором сплошь и рядом попадаются getByName, мне так и слышится, что интерпретатор Basic'а шипит "Блин, ты не выпендривайся, ты пальцем покажи!.."
Строковые операции сами по себе штука довольно медленная - компьютер изначально создавался для работы с целыми числами. Для него целочисленные индексы просто как конфеты. Так почему не побаловать железного друга? А он нас за это побалует высокой скоростью...
Цитата: Aleksandr H. от 14 ноября 2014, 22:20(ааааа. страшная фраза "создаётся курсор")
Ну а здесь-то чего страшного? Мышиного курсора не боишься, текстового курсора тоже - так чего паниковать? Ну да, объект, который может прыгать по всему листу как будто мы тискаем Ctrl+Home, Ctrl+Shift+End, стрелка влево или вверх... Ну обозвали его "курсором"... А как еще его можно назвать?
Цитата: Aleksandr H. от 14 ноября 2014, 22:20Вообще много чего не знаю. Почти каждый интересующий момент ищу в Интернете. Туториала б хорошего :-[
Дык
есть же (http://forumooo.ru/index.php/topic,3925.0.html)! И написано, и переведено очень толково!
Цитата: Aleksandr H. от 14 ноября 2014, 22:20Итог, наваял индусского ненужного кода, а вы в параллельной ветке так изящно оформили все.
Не заморачивайся - не согрешишь, не покаешься... Мы на этой планете живём в том числе и для того, чтобы топтаться по граблям.
И не "выкай" здесь! ;D
Цитата: Aleksandr H. от 14 ноября 2014, 22:20"Важко в світі жити безтолковому" :D
Зато как интересно!!!
После прочтения комментариев захотелось ускорить макрос. Получилось 2 варианта, первый работал 143 сек, а второй 132. Что уже огромный плюс в производительности :). А в starbasic'e нельзя реализовать такой вариант копирования: скопировать строку, выделить столбец и вставить данные с буфера обмена? ну как это вручную делается ;)
sub cos2
dim oSheet as object
dim oDoc as object
dim i as integer
Dim oSheets As Variant
dim oCursor as Object
dim LastRow as integer
dim oColumn as object, oRplDsc as object
oDoc = thisComponent
oSheet = oDoc.getCurrentController.getActiveSheet
oSheet.getRows.insertByIndex(0, 1 )
oCursor= oSheet.createCursor
oCursor.gotoEndOfUsedArea(False)
LastRow= oCursor.RangeAddress.EndRow
t = Timer
oSheet.GetCellByPosition (2,0).string = "Перевірка часу"
oSheet.GetCellByPosition (3,0).string = "Дата"
oSheet.GetCellByPosition (4,0).string = "Середня температура"
oSheet.GetCellByPosition (5,0).string = "Кількість дат"
oColumn = oSheet.getColumns().getByIndex(1) ' Получили вторую колонку целиком
oRplDsc = oColumn.createReplaceDescriptor() ' Создали для неё дескриптор замены
oRplDsc.setSearchString(".") ' Искать точку
oRplDsc.setReplaceString(",") ' Менять на запятую
oColumn.replaceAll(oRplDsc) ' Фас!
REM первый вариант
oSheet.GetCellByPosition(2,lastrow).formula = "=ISNUMBER(FIND(RIGHT(A" & lastrow+1 &";5);"+CHR$(34)+"12:00 15:00"+CHR$(34)+"))"
oSheet.GetCellByPosition(3,lastrow).formula = "=IF(C" & lastrow+1 &"=1;left(A" & lastrow+1 &"; 10);"+CHR$(34)++CHR$(34)+")"
oSheet.GetCellByPosition(4,lastrow).formula = "=IF(C"& lastrow+1 & "=1;AVERAGEIF(D$1:D$9000;D" & lastrow+1 & ";B$1:B$9000);"+CHR$(34)++CHR$(34)+")"
oSheet.GetCellByPosition(5,lastrow).formula = "=countif(D$1:D"& lastrow+1 &";D"& lastrow+1 &")"
oRange = oSheet.getCellRangeByPosition(2,1,5,lastrow)
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_TOP, 1)
REM - конец первого варианта
REM второй вариант
' for i = lastrow to 1 step -1
' oSheet.GetCellByPosition(2,i).formula = "=ISNUMBER(FIND(RIGHT(A" & i+1 &";5);"+CHR$(34)+"12:00 15:00"+CHR$(34)+"))"
' r = oSheet.GetCellByPosition(2,i).string
' 'if oSheet.GetCellByPosition(2,i).string = "TRUE" then
' oSheet.GetCellByPosition(3,i).formula = "=IF(C" & i+1 &"=1;left(A" & i+1 &"; 10);"+CHR$(34)++CHR$(34)+")"
' oSheet.GetCellByPosition(4,i).formula = "=IF(C"& I+1 & "=1;AVERAGEIF(D1:D9000;D" & i+1 & ";B1:B9000);"+CHR$(34)++CHR$(34)+")"
' oSheet.GetCellByPosition(5,i).formula = "=countif(D1:D"& i+1 &";D"& i+1 &")"
' 'end if
'
' next i
REM конец второго варианта
oSheets = ThisComponent.getSheets()
If oSheets.hasByName("Sheet") Then oSheets.removeByName("Sheet") 'якщо є СНЕЕТ то видалити його
oSheets.insertNewByName("Sheet", 0) ' створити лист СНЕЕТ
oSheet.getCellByPosition(15,0).string = Format(Timer - t, "0.00000")
end sub
Цитата: Aleksandr H. от 15 ноября 2014, 23:03После прочтения комментариев захотелось ускорить макрос. Получилось 2 варианта, первый работал 143 сек, а второй 132. Что уже огромный плюс в производительности
Насчёт огромного плюса я сомневаюсь, у меня первый вариант отрабатывает за 52 сек. Интересно как у других.
Цитата: Aleksandr H. от 15 ноября 2014, 23:03А в starbasic'e нельзя реализовать такой вариант копирования: скопировать строку, выделить столбец и вставить данные с буфера обмена? ну как это вручную делается
Можно через диспетчер.
Можно через диспетчер, можно и рукописным макросом... Только два вопроса:
1. Я, наверное, не правильно прочитал - "скопировать строку, выделить столбец и вставить данные..." Или ты именно это имел в виду? Опрокинуть (транспонировать) ячейки?
2. До Питоньяка так и не добрался? См. 5.23.2. Copy Spreadsheet Cells Without The Clipboard и 5.23.1. Copy Spreadsheet Cells With The Clipboard.
В первом из них приблизительно такой код:
Sub exampleCopyRange
Dim oSheet As Variant
Dim aRangeAddress As New com.sun.star.table.CellRangeAddress
Dim aCellAddress As New com.sun.star.table.CellAddress
oSheet = ThisComponent.getSheets().getByIndex(0) ' Первый лист книги (он есть всегда, не ошибемся)
aRangeAddress = oSheet.getRows().getByIndex(7).getRangeAddress() ' Адрес всей восьмой строки, на всю длину
aCellAddress = oSheet.getCellByPosition(0, 22).getCellAddress() ' Адрес первой ячейки в 23 строке
oSheet.copyRange(aCellAddress, aRangeAddress) ' Копирование
End SubНа самом деле Oliver Brinzing там чуть запутаннее написал: сначала взял адрес всего диапазона, куда будет копировать, потом взял адрес его первой ячейки... Реально для копирования нужно знать адрес диапазона, из которого копируем (лист, первая и последняя колонка, первая и последняя строка), и адрес ячейки, в которую копируем (лист, колонка, строка).
(Друг мой, вообще-то этот твой вопрос хоть и в продолжение темы, но все-таки совершенно самостоятельный. На форуме есть правило - новый вопрос = новая тема. Так незарегистрированным читателям проще отыскивать ответы на свои вопросы. Учти на будущее, ОК?)
Цитата: rami от 16 ноября 2014, 06:30Цитата: Aleksandr H. от Вчера в 21:03
После прочтения комментариев захотелось ускорить макрос. Получилось 2 варианта, первый работал 143 сек, а второй 132. Что уже огромный плюс в производительности
Насчёт огромного плюса я сомневаюсь, у меня первый вариант отрабатывает за 52 сек. Интересно как у других.
Пардон, хромает литературный язык :) В последнем коде есть 2 варианта решения - первый выполняется 143 сек, а второй (закомментирован) 132 сек. Это, в сравнении с кодом с сообщения #4, в разы быстрей
Он имел в виду, как в примере, скопировать диапазон C8348:F8348, а потом выделить диапазон C2:F8347 и вставить. Фактически растянуть фомулы.
Спасибо, rami, а то я в код не вчитывался... Потому и на не тот вопрос ответил. Можно формулы растянуть, и это очень просто:
oSheet.getCellRangeByName("C2:F8348").fillAuto(com.sun.star.sheet.FillDirection.TO_TOP, 1)
Только здесь внимательно надо: растягиваемая строка тоже должна в выделяемый диапазон попасть - не только ячейки куда копируем, но и исходные.
Вот мой вариант решения поставленной задачи, время выполнения не замерял, но, субъективно, секунды две.
Макрос вставляет обработанные данные справа от начальных через 1 столбец.
Sub Temperaturer
dim ShD as object ' Модель объекта табличного документа
dim ShL as object ' Модель объекта листа документа
dim N as long ' Переменная количества строк на листе
dim i as long ' Переменна счётчика
dim k as long ' Переменная ещё одного счётчика
dim l as long ' Переменная ещё одного счётчика
dim CR as object ' Модель диапазона ячеек
dim Dar as variant ' Массив данных диапазона ячеек
dim D1(0) as variant ' Выборка по времени
dim D2(0) as variant ' Сгрупированные данные
ShD=ThisComponent
ShL=ShD.sheets(0)
N=ubound(ShL.Data)
CR=ShL.getCellRangeByPosition(0,0,1,N)
Dar=CR.getDataArray()
k=-1
Rem Выборка отметок в 12:00 и 15:00
for i=0 to N
select case right(Dar(i)(0),5)
case "12:00","15:00"
k=k+1: redim preserve D1(k)
D1(k)=array(0,0)
D1(k)(0)=Dar(i)(0)
D1(k)(1)=Val(Dar(i)(1))
end select
next
Rem Нахождение средней температуры по 2-м или 1-й отметке
l=-1
for i=0 to k-1 step 2
l=l+1
redim preserve D2(l)
D2(l)=array(0,0)
if left(D1(i)(0),10)<>left(D1(i+1)(0),10) then
D1(i)(0)=left(D1(i)(0),10)
D2(l)(0)=D1(i)(0): D2(l)(1)=D1(i)(1)
i=i-1 ' Поправка перехода
else
D1(i)(0)=left(D1(i)(0),10)
D1(i)(1)=(D1(i)(1)+D1(i+1)(1))/2
D1(i+1)(0)=0: D1(i+1)(1)=0
D2(l)(0)=D1(i)(0): D2(l)(1)=D1(i)(1)
endif
next
CR=ShL.getCellRangeByPosition(3,0,4,ubound(D2()))
CR.setDataArray(D2()) ' Запись обратно на лист
End Sub
Да, довольно бодрый вариант... Шустрый и на предложенных данных работает без ошибок... кажется... ;D Да нет, действительно без ошибок, это я по привычке осторожничаю.
Пару моментов, наверное, стоило бы улучшить.
Во-первых, нам просто повезло, что данные в тестовой книге уже были отсортированы по убыванию даты-времени. Шли бы они в случайном порядке или хотя бы пара десятков дат уползли бы со своего места вверх или вниз - получили бы мы две-три тысячи значений, которые ни о чём не говорят. Поэтому, раз уж второй цикл ориентируется на строгое последовательное убывание дат, то начать макрос, пожалуй, следовало бы с принудительной сортировки данных. То ли прямо данные в листе отсортировать, то ли на массив D1 QuickSort натравить...
И во-вторых, тысяча ReDim'ов D2 - это сильное замедление алгоритма. Лучше было бы сразу определить его размером с D1 (больше не надо, на больше у нас значений не хватит), а в самом конце одним ReDim'ом обрезать лишний незаполненный хвост...
Повеселил конструкцией
N = UBound(ThisComponent.getSheets().getByIndex(0).getData())Сам придумал или где-то на форумах нарыл? :beer: