Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удалить строки, если в ячейке есть слеши - как? - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить строки, если в ячейке есть слеши - как? (Макросы/Sub)
Удалить строки, если в ячейке есть слеши - как?
wwizard Дата: Воскресенье, 10.07.2016, 00:39 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 160
Репутация: 0 ±
Замечаний: 40% ±

Есть прайс лист, местами в ячейке (10го столбца) попадаются такие значения:

\u0413\u0430\u043f\u0447\u0438\u043d\u0441\u043a\u0430\u044f
\u043d\u0441\u043a\u0430\u044f
\u0413\u0430\u043f\

Нужен макрос, который позволит удалить ВСЮ строку, если в ячейке 10го столбца будут найдены такие данные. Прайс состовляет 100 000 строк, желательно чтобы он быстро отработал.
Очень нужна помощь. Буду премного благодарен.

P.S> Есть такой скрипт:

[vba]
Код
Sub б_Удаление_строки_с_пустой_ячейкой_категорий8()
On Error Resume Next
ActiveSheet.UsedRange.Columns(8).SpecialCells(4).EntireRow.Delete
End Sub
[/vba]

Но он удаляет строки где найдены пустые ячейки в столбце 8. Может его возможно переделать, под мою задачу?
К сообщению приложен файл: 8258012.xlsx(10Kb)


Сообщение отредактировал Manyasha - Воскресенье, 10.07.2016, 12:56
 
Ответить
СообщениеЕсть прайс лист, местами в ячейке (10го столбца) попадаются такие значения:

\u0413\u0430\u043f\u0447\u0438\u043d\u0441\u043a\u0430\u044f
\u043d\u0441\u043a\u0430\u044f
\u0413\u0430\u043f\

Нужен макрос, который позволит удалить ВСЮ строку, если в ячейке 10го столбца будут найдены такие данные. Прайс состовляет 100 000 строк, желательно чтобы он быстро отработал.
Очень нужна помощь. Буду премного благодарен.

P.S> Есть такой скрипт:

[vba]
Код
Sub б_Удаление_строки_с_пустой_ячейкой_категорий8()
On Error Resume Next
ActiveSheet.UsedRange.Columns(8).SpecialCells(4).EntireRow.Delete
End Sub
[/vba]

Но он удаляет строки где найдены пустые ячейки в столбце 8. Может его возможно переделать, под мою задачу?

Автор - wwizard
Дата добавления - 10.07.2016 в 00:39
krosav4ig Дата: Воскресенье, 10.07.2016, 06:49 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1465
Репутация: 597 ±
Замечаний: 0% ±

Excel 2007, 2013
wwizard, а вы уверены, что эти строки нужно удалить?
а если их преобразовать в читабельный вид?
[vba]
Код
Sub gg()
    Dim cell As Range
    Set cell = Columns(10).Find("\u", , xlValues, xlPart)
    If Not cell Is Nothing Then
        With CreateObject("scriptcontrol")
            .Language = "JScript"
            Do While Not cell Is Nothing
                cell.Value = .Eval("unescape(""" & cell & """)")
                Set cell = Columns(10).FindNext(cell)
            Loop
        End With
    End If
End Sub
[/vba]


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Воскресенье, 10.07.2016, 06:50
 
Ответить
Сообщениеwwizard, а вы уверены, что эти строки нужно удалить?
а если их преобразовать в читабельный вид?
[vba]
Код
Sub gg()
    Dim cell As Range
    Set cell = Columns(10).Find("\u", , xlValues, xlPart)
    If Not cell Is Nothing Then
        With CreateObject("scriptcontrol")
            .Language = "JScript"
            Do While Not cell Is Nothing
                cell.Value = .Eval("unescape(""" & cell & """)")
                Set cell = Columns(10).FindNext(cell)
            Loop
        End With
    End If
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 10.07.2016 в 06:49
wwizard Дата: Воскресенье, 10.07.2016, 13:54 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 160
Репутация: 0 ±
Замечаний: 40% ±

а если их преобразовать в читабельный вид?


Уверен что нужно удалить.
 
Ответить
Сообщение
а если их преобразовать в читабельный вид?


Уверен что нужно удалить.

Автор - wwizard
Дата добавления - 10.07.2016 в 13:54
sv2014 Дата: Воскресенье, 10.07.2016, 14:51 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 166
Репутация: 37 ±
Замечаний: 0% ±

Excel 2013
wwizard, добрый день,протестируйте макрос на листе Лист2,кнопки test и повтор

[vba]
Код
Sub test()
     Dim z, i&: z = Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row).Value
  With CreateObject("VBScript.RegExp"): .Pattern = "\u\d+"
    For i = UBound(z) To 1 Step -1: If .test(z(i, 1)) Then Rows(i).Delete
    Next
  End With
End Sub
[/vba]
К сообщению приложен файл: example_10_07_2.xls(48Kb)
 
Ответить
Сообщениеwwizard, добрый день,протестируйте макрос на листе Лист2,кнопки test и повтор

[vba]
Код
Sub test()
     Dim z, i&: z = Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row).Value
  With CreateObject("VBScript.RegExp"): .Pattern = "\u\d+"
    For i = UBound(z) To 1 Step -1: If .test(z(i, 1)) Then Rows(i).Delete
    Next
  End With
End Sub
[/vba]

Автор - sv2014
Дата добавления - 10.07.2016 в 14:51
Karataev Дата: Воскресенье, 10.07.2016, 15:15 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 887
Репутация: 334 ±
Замечаний: 0% ±

Excel
Макрос без использования сторонних библиотек. Макрос удаляет строки, в которых в столбце J в начале ячейки есть текст "\u".
[vba]
Код
Sub Макрос()

    Dim arr(), lr As Long, i As Long
    
    Application.ScreenUpdating = False
    
    lr = Columns("J").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("J1:J" & lr).Value
    
    For i = UBound(arr) To 1 Step -1
        If InStr(1, arr(i, 1), "\u", vbTextCompare) = 1 Then
            Rows(i).Delete
        End If
    Next
    
    Application.ScreenUpdating = True

End Sub
[/vba]


 
Ответить
СообщениеМакрос без использования сторонних библиотек. Макрос удаляет строки, в которых в столбце J в начале ячейки есть текст "\u".
[vba]
Код
Sub Макрос()

    Dim arr(), lr As Long, i As Long
    
    Application.ScreenUpdating = False
    
    lr = Columns("J").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("J1:J" & lr).Value
    
    For i = UBound(arr) To 1 Step -1
        If InStr(1, arr(i, 1), "\u", vbTextCompare) = 1 Then
            Rows(i).Delete
        End If
    Next
    
    Application.ScreenUpdating = True

End Sub
[/vba]

Автор - Karataev
Дата добавления - 10.07.2016 в 15:15
Manyasha Дата: Воскресенье, 10.07.2016, 16:46 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 1974
Репутация: 817 ±
Замечаний: 0% ±

Excel 2010, 2016
[offtop] wwizard, не поленилась и пролистала последние 20 Ваших тем. Ни в одной из них Вы не отписались по предложенным решениям, подошло или нет.
Я подсмотрела, что плюсики Вы всем ставите - это здорово, но в самих темах, пожалуйста, отписывайтесь тоже, чтобы все видели.[/offtop]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение[offtop] wwizard, не поленилась и пролистала последние 20 Ваших тем. Ни в одной из них Вы не отписались по предложенным решениям, подошло или нет.
Я подсмотрела, что плюсики Вы всем ставите - это здорово, но в самих темах, пожалуйста, отписывайтесь тоже, чтобы все видели.[/offtop]

Автор - Manyasha
Дата добавления - 10.07.2016 в 16:46
krosav4ig Дата: Воскресенье, 10.07.2016, 17:05 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1465
Репутация: 597 ±
Замечаний: 0% ±

Excel 2007, 2013
добавил на всякий случай 2 кнопки 1я - для читабельности, 2я для удаления
[vba]
Код
Sub gg()
    Dim cell As Range
    Set cell = Columns(10).Find("\u", , xlValues, xlPart)
    If Not cell Is Nothing Then
        With CreateObject("scriptcontrol")
            .Language = "JScript"
            Do While Not cell Is Nothing
                cell.Value = .Eval("unescape(""" & cell & """)")
                Set cell = Columns(10).FindNext(cell)
            Loop
        End With
    End If
End Sub
Sub ggg()
    Dim cell As Range, rng As Range, addr$
    Set cell = Columns(10).Find("\u", , xlValues, xlPart)
    If Not cell Is Nothing Then
        addr = cell.Address
        Do
            If rng Is Nothing Then Set rng = cell _
                Else Set rng = Union(rng, cell)
            Set cell = Columns(10).FindNext(cell)
        Loop While cell.Address <> addr
        If Not rng Is Nothing Then rng.EntireRow.Delete
    End If
End Sub
[/vba]
К сообщению приложен файл: 8258012-1-.xlsm(21Kb)


(_)Õvõ(_)
 
Ответить
Сообщениедобавил на всякий случай 2 кнопки 1я - для читабельности, 2я для удаления
[vba]
Код
Sub gg()
    Dim cell As Range
    Set cell = Columns(10).Find("\u", , xlValues, xlPart)
    If Not cell Is Nothing Then
        With CreateObject("scriptcontrol")
            .Language = "JScript"
            Do While Not cell Is Nothing
                cell.Value = .Eval("unescape(""" & cell & """)")
                Set cell = Columns(10).FindNext(cell)
            Loop
        End With
    End If
End Sub
Sub ggg()
    Dim cell As Range, rng As Range, addr$
    Set cell = Columns(10).Find("\u", , xlValues, xlPart)
    If Not cell Is Nothing Then
        addr = cell.Address
        Do
            If rng Is Nothing Then Set rng = cell _
                Else Set rng = Union(rng, cell)
            Set cell = Columns(10).FindNext(cell)
        Loop While cell.Address <> addr
        If Not rng Is Nothing Then rng.EntireRow.Delete
    End If
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 10.07.2016 в 17:05
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить строки, если в ячейке есть слеши - как? (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!