Страницы: 1
RSS
Преобразование данных с посекундными значениями в поминутные с удалением лишних строк
 
Имеется массив данных с оборудования снятых с очень частыми интервалами (несколько раз в секунду). Стоит задача сделать выборку поминутно с удалением излишнего количества данных, т.е. строк. Количество строк более 43К. Вручную просто не реально. Помогите, как это автоматизировать???
 
Не самый быстрый
Код
Sub qq()
    Dim lr&, i&, sTime$
    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    sTime = Right(Cells(lr, 2).Text, 2)
    For i = lr - 1 To 2 Step -1
        If Right(Cells(i, 2).Text, 2) = sTime Then
            Rows(i).Delete
        Else
            sTime = Right(Cells(i, 2).Text, 2)
        End If
    Next
End Sub
Изменено: RAN - 16.01.2018 13:40:10
 
КИА092, может преобразовать в умную таблицу (чтобы удалялись строки целиком, а не ячейки со сдвигом) и использовать инструмент "удалить дубликаты" на столбце В?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Вариант с расширенным фильтром
Код
Sub Макрос3()
    [I2].Formula = "=F2=F3"
    Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, _
      CriteriaRange:=Range("I1:I2"), Unique:=False
    Range(Rows(2), Rows(Rows.Count)).Delete Shift:=xlUp
    ActiveSheet.ShowAllData
End Sub
 
#4 - замечательно! Не знал о таком использовании расширенного фильтра. Очередное раскрытие тайн объекта Range от Алексея.
На мой взгляд, в строке 2 можно указать в формуле "=F2=F1", чтобы первые значения из повторяющихся оставались. Соответственно, удалять нужно с 3-й строки.
Изменено: sokol92 - 16.01.2018 16:22:13
Владимир
 
sokol92, да не совсем замечательно. Если количество строк более 43К, а Excel - 2007 или ранее, т.е. число областей диапазона SpecialCells, который тут неявно применяется, не может быть больше 8192, то удаление не сработает правильно. Нужно удалять кусками:
Код
Sub Макрос3()
Dim i&
  On Error Resume Next
  [I2].Formula = "=F2=F3"
  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("I1:I2"), Unique:=False
  For i = 2 To ActiveSheet.UsedRange.Rows.Count Step 16000
    Range(Rows(2), Rows(i + 16000)).Delete Shift:=xlUp
    DoEvents
  Next
  ActiveSheet.ShowAllData
End Sub
Быстрее будет перенести автофильтром неповторяющиеся строки в другое место, а исходные столбцы удалить.
 
Для эффективного удаления ячеек на сайте есть "классические" макросы от ZVI.
Владимир
 
Jack Famous, Да, и нужно целиком строки удалять!

Всё остальное попробую и отпишусь... Пока некогда было... выдернули из-за компа (
Спасибо за советы!
 
RAN,Этот макрос убрал строки где повторялись записи в одну и ту же секунду, а надо оставить только поминутные значения. (не нужна такая точность).
 
Цитата
КИА092 написал:
оставить только поминутные значения
Так?
Код
Sub qq()
    Dim lr&, i&, sTime$
    Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    sTime = Left(Cells(lr, 2).Text, 5)
    For i = lr - 1 To 2 Step -1
        If Left(Cells(i, 2).Text, 5) = sTime Then
            Rows(i).Delete
        Else
            sTime = Left(Cells(i, 2).Text, 5)
        End If
    Next
End Sub
Если время до 10:00 записано в ваших логах как 9:59 к примеру, тогда 5 в коде замените на len(Cells(lr, 2).Text)-3
 
Выставлю и свой макрос.
Скрытый текст
 
Doober, Большое человеческое спасибо!
Всё получилось!!!
Страницы: 1
Наверх