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

Вход

Регистрация

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

 

= Мир MS Excel/Как удалить строки, в колонке из которых обрывистые тексты - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как удалить строки, в колонке из которых обрывистые тексты (Формулы/Formulas)
Как удалить строки, в колонке из которых обрывистые тексты
Jingo Дата: Пятница, 20.10.2017, 01:53 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
Уважаемые, посоветуйте макрос, который бы удалял строку, если у неё начало текста строго в одной колонке E точно такое-же как у другой строки в количестве N символов.
Надо удалять строка которая с меньшим числом символом

1 Текст1 Медицина в Германии во времена Третьего Рейха История европейской медицины. Какие эксперименты проводились в Нацистской ...
2 Текст2 Медицина в Германии во времена Третьего Рейха История европейской медицины. Какие эксперименты проводились в Нацистской Германии, как это отразилось на развитии медицины.


Сообщение отредактировал Jingo - Пятница, 20.10.2017, 06:31
 
Ответить
СообщениеУважаемые, посоветуйте макрос, который бы удалял строку, если у неё начало текста строго в одной колонке E точно такое-же как у другой строки в количестве N символов.
Надо удалять строка которая с меньшим числом символом

1 Текст1 Медицина в Германии во времена Третьего Рейха История европейской медицины. Какие эксперименты проводились в Нацистской ...
2 Текст2 Медицина в Германии во времена Третьего Рейха История европейской медицины. Какие эксперименты проводились в Нацистской Германии, как это отразилось на развитии медицины.
Автор - Jingo
Дата добавления - 20.10.2017 в 01:53
Jingo Дата: Пятница, 20.10.2017, 05:28 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
[vba]
Код
Sub DeleteDubls()
Const intDataCol = 1
Const intMaxRow = 50
Dim i%, j%
Dim strValue1$, strValue2$
For i = 2 To intMaxRow - 1
strValue1 = Trim(Cells(i, intDataCol))
For j = i + 1 To intMaxRow
strValue2 = Trim(Cells(j, intDataCol))
[b] If Left(strValue1, 10) = Left(strValue2, 10) Then
Cells(j, intDataCol).Delete shift:=xlUp[/b]
End If
Next
Next
End Sub
[/vba]

что тут поправить чтобы заработало?)


Сообщение отредактировал Jingo - Пятница, 20.10.2017, 06:55
 
Ответить
Сообщение[vba]
Код
Sub DeleteDubls()
Const intDataCol = 1
Const intMaxRow = 50
Dim i%, j%
Dim strValue1$, strValue2$
For i = 2 To intMaxRow - 1
strValue1 = Trim(Cells(i, intDataCol))
For j = i + 1 To intMaxRow
strValue2 = Trim(Cells(j, intDataCol))
[b] If Left(strValue1, 10) = Left(strValue2, 10) Then
Cells(j, intDataCol).Delete shift:=xlUp[/b]
End If
Next
Next
End Sub
[/vba]

что тут поправить чтобы заработало?)
Автор - Jingo
Дата добавления - 20.10.2017 в 05:28
Shurf Дата: Пятница, 20.10.2017, 06:52 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 40
Репутация: 8 ±
Замечаний: 0% ±

Excel 2010
Jingo, Добрый день, оформите код в своём сообщении, в соответствии с правилами форума тегами (нажав "Правка", выделите код в сообщении и нажмите на панели вверху кнопку #) , да и файл пример не помешает с тем что есть и что хотите получить.


Сообщение отредактировал Shurf - Пятница, 20.10.2017, 06:54
 
Ответить
СообщениеJingo, Добрый день, оформите код в своём сообщении, в соответствии с правилами форума тегами (нажав "Правка", выделите код в сообщении и нажмите на панели вверху кнопку #) , да и файл пример не помешает с тем что есть и что хотите получить.
Автор - Shurf
Дата добавления - 20.10.2017 в 06:52
Manyasha Дата: Пятница, 20.10.2017, 11:29 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 902 ±
Замечаний: 0% ±

Excel 2010, 2016
Jingo, попробуйте так:
[vba]
Код
Sub DeleteDubls()
    Const intDataCol = 1
    Const intMaxRow = 50
    Dim i%, j%
    Dim strValue1$, strValue2$
    For i = intMaxRow To 2 Step -1
        strValue1 = Trim(Cells(i, intDataCol))
        For j = 2 To i - 1
            strValue2 = Trim(Cells(j, intDataCol))
            If Left(strValue1, 10) = Left(strValue2, 10) Then
                If Len(strValue1) > Len(strValue2) Then
                    Cells(j, intDataCol).Delete shift:=xlUp
                Else
                    Cells(i, intDataCol).Delete shift:=xlUp
                End If
            End If
        Next
    Next
End Sub
[/vba]

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеJingo, попробуйте так:
[vba]
Код
Sub DeleteDubls()
    Const intDataCol = 1
    Const intMaxRow = 50
    Dim i%, j%
    Dim strValue1$, strValue2$
    For i = intMaxRow To 2 Step -1
        strValue1 = Trim(Cells(i, intDataCol))
        For j = 2 To i - 1
            strValue2 = Trim(Cells(j, intDataCol))
            If Left(strValue1, 10) = Left(strValue2, 10) Then
                If Len(strValue1) > Len(strValue2) Then
                    Cells(j, intDataCol).Delete shift:=xlUp
                Else
                    Cells(i, intDataCol).Delete shift:=xlUp
                End If
            End If
        Next
    Next
End Sub
[/vba]
Автор - Manyasha
Дата добавления - 20.10.2017 в 11:29
InExSu Дата: Воскресенье, 22.10.2017, 20:06 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 650
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
Привет!
Раз примера нет, намоделировал сам себе.

[vba]
Код
Option Explicit

Dim arr(), i

Sub БезХвоста_InExSu()
    ActiveSheet.Copy
    With ActiveSheet
        arr = .[a1].CurrentRegion.Value
        Dim Z: Z = .[a1].CurrentRegion.Sort(.[a1], xlAscending, Header:=xlYes)
        For i = .[a1].CurrentRegion.Rows.Count To 2 Step -1
            If InStr(.Cells(i, 1), .Cells(i - 1, 1)) > 0 Then _
               .Rows(i - 1).Delete
        Next
    End With
End Sub
[/vba]
К сообщению приложен файл: Jingo_______exc.xlsb (15.2 Kb)

Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
 
Ответить
СообщениеПривет!
Раз примера нет, намоделировал сам себе.

[vba]
Код
Option Explicit

Dim arr(), i

Sub БезХвоста_InExSu()
    ActiveSheet.Copy
    With ActiveSheet
        arr = .[a1].CurrentRegion.Value
        Dim Z: Z = .[a1].CurrentRegion.Sort(.[a1], xlAscending, Header:=xlYes)
        For i = .[a1].CurrentRegion.Rows.Count To 2 Step -1
            If InStr(.Cells(i, 1), .Cells(i - 1, 1)) > 0 Then _
               .Rows(i - 1).Delete
        Next
    End With
End Sub
[/vba]
Автор - InExSu
Дата добавления - 22.10.2017 в 20:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как удалить строки, в колонке из которых обрывистые тексты (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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