Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Найти нужные значения (начало, конец) а все, что не попадает в диапазон удалить.
 
#1
24.03.2019 20:04:15

Доброго времени Уважаемые Форумчане!

Помогите пожалуйста с макросом.

На Листе1 находятся данные в столбцах D:I. Нужно оставить данные от Начала – ячейка В4 до Конца – ячейка D4, а все остальные удалить. Нужный результат показал на Листе2.

В столбце В склеил данные столбцов D и Е, что бы можно было производить поиск строк с нужным значением.
 
 
 
#2
24.03.2019 20:16:48
Цитата
mikolaychik написал: В столбце В склеил данные столбцов D и Е, что бы можно было производить поиск строк с нужным значением
Т.е. в исходном варианте столбца 'B' нет?
Раз уж Вы его сделали, то достаточно фильтра по дате и скопировать отобранные строки в другое место
Изменено: Sanja - 24.03.2019 20:17:29
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
24.03.2019 20:23:33
Да вы правы в исходном варианте столбца В нет, исходные данные находятся в столбцах D:I.
Сам думал про фильтр, но с ним не совсем удобно… Вот и подумал, что может быть макросом получится!!!
 
 
 
#4
24.03.2019 20:40:50
Ну макросом, так макросом
Код
Sub myFilter()
Dim arr(), arrNew(), I&, J&, N&
Dim iStart As Date, iFinish As Date
With ActiveSheet
    arr = .Range("C9:I" & .Cells(.Rows.Count, "D").End(xlUp).Row).Value
    iStart = CDate(.Range("B4").Value)
    iFinish = CDate(.Range("D4").Value)
    ReDim arrNew(1 To UBound(arr), 1 To UBound(arr, 2)): N = 1
    For I = 1 To UBound(arr)
        If CDate(arr(I, 2) + arr(I, 3)) >= iStart And CDate(arr(I, 2) + arr(I, 3)) <= iFinish Then
            For J = 1 To UBound(arr, 2)
                arrNew(N, J) = arr(I, J)
            Next
            N = N + 1
        End If
    Next
    .Range("K9").Resize(N, UBound(arrNew, 2)) = arrNew
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
24.03.2019 21:06:08

Sanja Огромное Спасибо!!!

Почти то что нужно. Данные со столбца С не нужны – это всего лишь порядковые номера строк.

Я так понимаю на старое место D:I, удалив старые данные, вставить эти новые данные не получится? Если нет то можно, что бы новые данные вставлялись на новый Лист2 начиная с А1.

Еще раз Огромное Спасибо!!!

 
 
 
#6
24.03.2019 21:12:41
Цитата
mikolaychik написал: удалив старые данные, вставить эти новые данные
Код
Sub myFilter()
Dim arr(), arrNew(), I&, J&, N&
Dim iStart As Date, iFinish As Date
With ActiveSheet
    arr = .Range("D9:I" & .Cells(.Rows.Count, "D").End(xlUp).Row).Value
    iStart = CDate(.Range("B4").Value)
    iFinish = CDate(.Range("D4").Value)
    ReDim arrNew(1 To UBound(arr), 1 To UBound(arr, 2)): N = 1
    For I = 1 To UBound(arr)
        If CDate(arr(I, 1) + arr(I, 2)) >= iStart And CDate(arr(I, 1) + arr(I, 2)) <= iFinish Then
            For J = 1 To UBound(arr, 2)
                arrNew(N, J) = arr(I, J)
            Next
            N = N + 1
        End If
    Next
    .Range("D9:I" & .Cells(.Rows.Count, "D").End(xlUp).Row).ClearContents
    .Range("D9").Resize(N, UBound(arrNew, 2)) = arrNew
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
24.03.2019 21:19:22

Sanja Огромное Спасибо!!!

У меня просто нет слов. Все просто супер!!!

СПАСИБО!!!
 
 
 
Страницы: 1
Наверх