Удаление необходимых строк

[Feers1de]

Здравствуйте!

Прикреплённый файл - таблица с показаниями температур за 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

После использования макроса получился какой-то бардак - не то, что я ожидал....

[JohnSUN]

Зря, наверное, из Calc'а сюда убежал... Есть мнение, что без макроса, одними встроенными функциями Calc'а задача решается очень быстро.

[Feers1de]

Может она и есть - но я не нашёл её.

[Aleksandr H.]

Попробуй макрос  
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 записей долго уж будет считать 

[rami]

Попробуй макрос

Что-то никого не видно на форуме , наверно, пробуют макрос...

[JohnSUN]

Да нет, уже распробовали... Теперь в засаде сидим, ждём интересных вопросов.

[RAN]

p.s. только на 9k записей долго уж будет считать

Не то слово. Надоело на первой сотне. 
Мне 5 сек больше нравится. А лучше 2.

[JohnSUN]

А, ну да... Поругать-то каждый мастак! А советом помочь? "Делай как я!.." (с) Б.Титомир

Aleksandr H., друг мой, есть несколько соображений, как избавиться от этих проблем:

2 условия на входные данные:
1) в столбце температуры заменить "." на ",". По крайней мере у меня в ОС разделить целой и дробной части ","
2) в файле должен быть лист с названием "Sheet"
3) только на 9k записей долго уж будет считать 

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 прозевал поправку:там не 16:00, а 15:00. Да и формула =ISNUMBER(FIND(RIGHT(A47;5);"12:00 15:00")) выглядит короче, хоть и даёт тот же результат.
г) вписывание формул в колонки E, F и G в большинстве случаев будет лишним - ты же сейчас эту строку удалишь, так зачем что-то туда писать? Лучше бы перенести эти действия в ветку ELSE - не удаляем строку, значит пишем формулы
д) само удаление строк - операция, наверное, и не очень-то нужная. Нет, я понимаю, что автор вопроса именно об этом просил, но раз уж результат будет опубликован на отдельном листе, то с листа с исходными данными можно было бы строки и не удалять - это намного ускорило бы процесс. Кстати, обычно если внутри цикла есть удаление элементов, то принято строить цикл "задом наперед", снизу вверх. Тогда в случае удаления не приходится играться с индексом, то вычитать единичку, то опять прибавлять.
е) размножение формул тоже можно было бы сделать очень быстро. Для этого у диапазонов ячеек есть специальный метод fillAuto - вписываешь формулы только в одну строку, определяешь диапазон, так чтобы эта строка в нем была первой и вызываешь fillAuto: щелк и все формулы внесены и посчитаны.

А вообще, молодец! Да, долго... Но результат-то именно тот, что и просили!

[Aleksandr H.]

JohnSUN , спасибо за поддержку!
Мои комментарии:  Конечно я мог сделать замену точки на запятую и добавить новый лист  . Для 1 пункта тоже думал сделать через формулу, но не через VALUE а с помощью IFов б обыграл возникновение ошибки. Но твой вариант (в), имхо, оптимальный. Только я, к своему стыду, ваашпе не ориентируюсь что такое дескрипторы и какие они бывают. 
Пункт 2. Признаюсь, поленился поискать как вставить новый лист. Только, о5 же, я не знал про метод hasByName("Sheet"), я б в гугле писал "open office basic перебрать листы scalc", узнал как перебрать в листы и в цикле смотрел на имена листов не встречается ли там "SHEET". 
Пункт 3.

Лучше использовать приём, который задействован в функции GetLastUsedRow (библиотека Tools, модуль Misc) - для листа создаётся курсор, ему даёшь команду GotoEndOfUsedArea и тут же узнаёшь последнюю строку и последнюю колонку с данными.

Да, ты мне показывал как использовать GetLastUsedRow и правильно было б её использовать, только на пару милисекунд после мысли про GetLastUsedRow пришла мысля "Да ну, эти данные это результат какого-то запроса, не может быть пустой ячейки". Каюсь 
ByIndex легче Basic'y, a ByName легче для меня ;-) (ааааа. страшная фраза "создаётся курсор")

=ISNUMBER(FIND(RIGHT(A47;5);"12:00 15:00")) это разрыв шаблона, атака с тыла :-)

Кстати, обычно если внутри цикла есть удаление элементов, то принято строить цикл "задом наперед", снизу вверх.

Не знал, постараюсь запомнить. Вот здесь б и использовалась функция GetLastUsedRow ;-)

специальный метод fillAuto - вписываешь формулы только в одну строку, определяешь диапазон, так чтобы эта строка в нем была первой и вызываешь fillAuto: щелк и все формулы внесены и посчитаны.

Не знал.

Вообще много чего не знаю. Почти каждый интересующий момент ищу в Интернете. Туториала б хорошего   

Итог, наваял индусского ненужного кода, а вы в параллельной ветке так изящно оформили все. Как говорит коллега "Важко в світі жити безтолковому"   

[JohnSUN]

Только я, к своему стыду, ваашпе не ориентируюсь что такое дескрипторы и какие они бывают. 

"Спокойствие, только спокойствие!"(с)Карлсон
Нам ли бояться каких-то там дескрипторов? Мы же мегакруты, мы знаем каратэ, джиу-джитсу, кунг-фу и ещё кучу страшных слов!
Слово "дескриптор" выглядит так погано потому что для него не придумали хорошего перевода. А на самом-то деле штука очень простая.
Вот нажми Ctrl+H и попробуй выписать в столбик все поля и флажки, которые в этой форме видишь:

Код Выделить Развернуть

Найти - строка поиска - умолчания нет
Заменить на - строка замены - по умолчанию пустая строка (менять на "ничто")
Учитывать регистр - флажок (логическое) - по умолчанию "Нет"
Ячейку целиком - флажок (логическое) - по умолчанию "Нет"
Регулярные выражения -  - флажок (логическое) - по умолчанию "Нет" и так далееВот весь этот набор параметров поиска/замены, собранный в одну кучу (в одну структуру, в одну запись, в один объект), и дополненный несколькими методами типа getSearchString или setReplaceString - это и есть "дескриптор" ("описатель" - ударение на "а"). Для чего эта беда придумана? А просто чтобы вызывать findAll или replaceAll всего с одним параметром. Знаешь как в VBA выглядит вызов Replace? А вот так:

Код Выделить Развернуть

expression.Replace(What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte, SearchFormat, ReplaceFormat)Так чтобы вот так же через запятую не перечислять всё что нужно и не нужно - создаем запись-дескриптор, отдельными присваиваниями меняем только те значения, которые нужны не "умолчальные", и запускаем поиск или замену, указав в качестве параметра одну переменную, в которую упаковано всё что может потребоваться...
Всё это довольно просто. Самое сложное - придумать нормальное слово, которое передавало бы смысл всех этих действий. Не придумали пока, оставили "дескриптором", людей пугают...

ByIndex легче Basic'y, a ByName легче для меня ;-)

Ну, не знаю, дело хозяйское... Но когда я запускаю макрос, в котором сплошь и рядом попадаются getByName, мне так и слышится, что интерпретатор Basic'а шипит "Блин, ты не выпендривайся, ты пальцем покажи!.."
Строковые операции сами по себе штука довольно медленная - компьютер изначально создавался для работы с целыми числами. Для него целочисленные индексы просто как конфеты. Так почему не побаловать железного друга? А он нас за это побалует высокой скоростью...

(ааааа. страшная фраза "создаётся курсор")

Ну а здесь-то чего страшного? Мышиного курсора не боишься, текстового курсора тоже - так чего паниковать? Ну да, объект, который может прыгать по всему листу как будто мы тискаем Ctrl+Home, Ctrl+Shift+End, стрелка влево или вверх... Ну обозвали его "курсором"... А как еще его можно назвать?

Вообще много чего не знаю. Почти каждый интересующий момент ищу в Интернете. Туториала б хорошего   

Дык есть же! И написано, и переведено очень толково!

Итог, наваял индусского ненужного кода, а вы в параллельной ветке так изящно оформили все.

Не заморачивайся - не согрешишь, не покаешься... Мы на этой планете живём в том числе и для того, чтобы топтаться по граблям.
И не "выкай" здесь! 

"Важко в світі жити безтолковому"   

Зато как интересно!!!

[Aleksandr H.]

После прочтения комментариев захотелось ускорить макрос. Получилось 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

[rami]

После прочтения комментариев захотелось ускорить макрос. Получилось 2 варианта, первый работал 143 сек, а второй 132. Что уже огромный плюс в производительности

Насчёт огромного плюса я сомневаюсь, у меня первый вариант отрабатывает за 52 сек. Интересно как у других.

А в starbasic'e нельзя реализовать такой вариант копирования: скопировать строку, выделить столбец и вставить данные с буфера обмена? ну как это вручную делается

Можно через диспетчер.

[JohnSUN]

Можно через диспетчер, можно и рукописным макросом... Только два вопроса:
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 там чуть запутаннее написал: сначала взял адрес всего диапазона, куда будет копировать, потом взял адрес его первой ячейки... Реально для копирования нужно знать адрес диапазона, из которого копируем (лист, первая и последняя колонка, первая и последняя строка), и адрес ячейки, в которую копируем (лист, колонка, строка).
(Друг мой, вообще-то этот твой вопрос хоть и в продолжение темы, но все-таки совершенно самостоятельный. На форуме есть правило - новый вопрос = новая тема. Так незарегистрированным читателям проще отыскивать ответы на свои вопросы. Учти на будущее, ОК?)

[Aleksandr H.]

Цитата: Aleksandr H. от Вчера в 21:03
После прочтения комментариев захотелось ускорить макрос. Получилось 2 варианта, первый работал 143 сек, а второй 132. Что уже огромный плюс в производительности
Насчёт огромного плюса я сомневаюсь, у меня первый вариант отрабатывает за 52 сек. Интересно как у других.

Пардон, хромает литературный язык В последнем коде есть 2 варианта решения - первый выполняется 143 сек, а второй (закомментирован) 132 сек. Это, в сравнении с кодом с сообщения #4, в разы быстрей

[rami]

Он имел в виду, как в примере, скопировать диапазон C8348:F8348, а потом выделить диапазон C2:F8347 и вставить. Фактически растянуть фомулы.