Страницы: 1
RSS
[ Закрыто ] Помогите оптимизировать Код с макрорекодера, Подправить код для протягивания формулы до конца таблицы
 
Всем здравствуйте!
Помогите пожалуйста подправить код в макросе (записывал в макрорекодере).
Суть макроса: в столбце Е есть данные по продолжительности звонка, которые имеют вид "N мин", "N мин, N сек", "N сек" и "пустые". Формулой в столбце М я проверяю содержит ли ячейка в столбце Е слово "мин", если содержит то она вставляется без изменения, если нет, то сцепляю ячейку вставляя "0 мин, ", чтобы получить формат там где нет значения минут "0 мин, N сек". Затем двойным нажатием по черному крестику протягиваю формулу до конца таблицы. Удаляю формулы в столбце М. После этого разделяю значение в столбце М с помощью "Текст по столбцам" через пробел, так чтобы цифры минут и секунд были в отдельных столбцах ( М и О соответственно). в столбце Q через формулу =ВРЕМЯ(0;М"О) преобразую данные во время, меняю формат на 37:30:55, и двойным щелчком по черному крестику протягиваю до конца таблицы. После удаляю формулы из столбца Q, и вырезаю столбцы до столбца Q, так чтобы эти значения оказались в столбце М. В ячейку М1 вставляю название столбца таблицы "Трафик".
Макрорекодер записал так что формулы протягиваются до 4297 строки, но мне это не подходит, так как строк может быть от 100 и до 500к, мне нужно чтобы макрос протягивал формулу до конца таблицы. Понимаю что нужно что-то поменять в строках кода 11-12 и 29-30, но на что менять так и не понял, так как не в зуб ногой в ВБА. Просмотрел ответы на форуме, но так и не разобрался. Поэтому прошу людей знающих помочь подправить код.
Заранее огромное спасибо!!!
Пример в приложении.
 
Здравствуйте.
Так пойдет?
Код
Sub Преобразовать_время()
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
        dx = .Range("E1:E" & LastRow)
        dx(1, 1) = "Трафик"
        For n = 2 To UBound(dx)
            Tm = dx(n, 1)
            Tm = Replace(Tm, "мин", ":")
            Tm = Replace(Tm, ",", "")
            Tm = Replace(Tm, " ", "")
            Tm = Replace(Tm, "сек", "")
            If InStr(1, Tm, ":", vbTextCompare) = 0 Then Tm = "00:" & Tm
            If Right(Tm, 1) = ":" Then Tm = Tm & "00"
            dx(n, 1) = CDate(Tm)

        Next
        .Range("M1:M" & UBound(dx)).Select
        Selection.NumberFormat = "[h]:mm:ss;@"
        .Range("M1").Select
        .Range("M1").Resize(UBound(dx), 1) = dx
    End With

End Sub
 
Doober, выдает ошибку в 14 строке кода
Изменено: Артем_П - 13.04.2018 12:25:13
 
название должно отражать суть задачи
 
vikttur, прошу прощения за свое косноязычие, постарался описать суть в первом сообщении
 
Ошибка в коде предложенном Doober, в следующем: макрос выводит данные принимая что минуты это часы, а секунды = минуты, и если в ячейке значение больше 24 мин, то он запинается, т.е. нужно чтобы он ставил минуты именно как минуты, а сек как секунды. Но мне можно просто поправить код что в примере так чтобы он протягивал формулу до конца таблицы, там это встречается в двух местах.
Изменено: Артем_П - 13.04.2018 14:13:34
 
Читайте правила форума
название в личку. модератор заменит
Страницы: 1
Наверх