Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
До строки с отметкой оставить нужное количество строк
 
Здраствуйте, возможно ли сделать следующее? есть информация в виде

строка 1
строка 2
строка 3
строка 4
строка 5
строка 6 ( с запятой)

строка 1
строка 2
строка 3
строка 4  ( с запятой)

СРОЧНО
строка 1
строка 2
строка 3
строка 4
строка 5  ( с запятой)

необходимо оставить только 4 строки вверх от строки с запятой, а если есть слово СРОЧНО то его не удалять, и не должно быть пустой строки между словом СРОЧНО и верхней строкой, должно выглядеть так

строка 3
строка 4
строка 5
строка 6 ( с запятой)

строка 1
строка 2
строка 3
строка 4  ( с запятой)
СРОЧНО
строка 2
строка 3
строка 4
строка 5  ( с запятой)  
 
Доброе время суток
Цитата
Павел написал:
должно выглядеть так
Павел, точно? В правилах почему-то
Цитата
2.3. Приложите файл(ы) с примером (общим весом не более 300Кб) в реальной структуре и форматах данных того, что есть сейчас и того, что хотелось бы на выходе.
 
Андрей VG, исправляюсь
Изменено: Павел - 21 фев 2021 17:17:42
 
Добрый день
Вопрос
имеется   такая инфа
*****
флешка 32 гб
ssd 256 гб
клавиатура
Иванов Иван
Ленина 12-12
Москва, 128000
на выходе должно быть:
хотелось   бы получить
клавиатура
Иванов Иван
Ленина 12-12
Москва, 128000
Эти данные не перенеслись

флешка 32 гб
ssd 256 гб
исходя из какой логики ?
Быстрее молнии, быстрее ветра, быстрее калькулятора
 
Borrusale,не нужны эти строчки просто
 
Макрос

Индекс ищу как шестизначное число после ", "
Если это условие не будет соблюдаться или вы в внесете наименование товара на подобии "клавиатура, 605001" то макрос сработает с ошибкой

Надо для индекса придумать другой ориентир. Например слово "индекс" перед номером, а вообще вынести в отдельный столбик.
Быстрее молнии, быстрее ветра, быстрее калькулятора
 
Borrusale, Спасибо большое
 
Другой вариант. Если строк много надо добавить после строки Dim Строчку
Код
Application.ScreenUpdating = False:
Код
Sub RemoveRows()
Dim Rg1 As Range
Set Rg1 = Cells(Rows.Count, 1).End(xlUp)
For i = Rg1.Row To 2 Step -1
If InStr(1, Cells(i, 1), ",", vbTextCompare) Then
i = i - 3
Else
    Select Case Cells(i, 1)
Case "СРОЧНО"
Case "*****": If Cells(i + 1, 1) = "СРОЧНО" Then Rows(i).Delete Else Cells(i, 1).ClearContents
Case "": Rows(i).Delete
Case Else
        Rows(i).Delete
    End Select
End If
Next i
End Sub
Изменено: Евгений Смирнов - 22 фев 2021 17:10:14
 
Евгений Смирнов, респектую тебе от всей души) вообще то что надо было, спасибо отромное!!!
 
Вариант с удалением ячеек
Код
Sub Remove1()
Dim Rg1 As Range
Application.ScreenUpdating = 0
Set Rg1 = Cells(Rows.Count, 1).End(xlUp)
For i = Rg1.Row To 2 Step -1
If InStr(1, Cells(i, 1), ",", vbTextCompare) Then
i = i - 3
Else
    Select Case Cells(i, 1)
Case "СРОЧНО"
Case "*****": If Cells(i + 1, 1) = "СРОЧНО" Then Cells(i, 1).Delete (xlUp) Else Cells(i, 1).ClearContents
Case "": Cells(i, 1).Delete (xlUp)
Case Else
        Cells(i, 1).Delete (xlUp)
    End Select
End If
Next i
End Sub
 
Евгений Смирнов, спасибо так лучше, но тут образовалась следующая проблема, этот макрос работает если ручками набрать все данные которые макросом обработать надо или скопировать и вставить текст с текстового файла, а если например берешь эти данные с другого листа в документе excel или просто их копируешь с другого листа то этот макрос уже неправильно работает, в результате не оставляет пустых ячеек между заказами

UPD: все разобрался, мой косяк был
Изменено: Павел - 23 фев 2021 12:37:35
 
Попробуйте мой вариант
Код
Sub ww()
Dim rng As Range
Dim iLastRow As Long
Dim iLR As Long
Dim Kol As Integer
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("C2:C" & iLastRow).ClearContents
  For Each rng In Range("A2:A" & iLastRow).SpecialCells(2, 3).Areas
    Kol = WorksheetFunction.CountIf(rng, "СРОЧНО")
    If Kol Then
      iLR = Cells(Rows.Count, "C").End(xlUp).Row + 1
      Cells(iLR, "C") = "СРОЧНО"
      iLR = iLR + 1
    Else
      iLR = Cells(Rows.Count, "C").End(xlUp).Row + 2
    End If
      Range(rng.Cells(rng.Count - 3), rng.Cells(rng.Count)).Copy Cells(iLR, "C")
  Next
End Sub
 
Kuzmich, Спасибо еще раз, макрос зашел как надо
Страницы: 1
Читают тему (гостей: 1)
Наверх