Страницы: 1
RSS
Команда не применима для перекрывающихся диапазонов, Удаление отфильтрованных строк работает только при предварительном отменении объединения ячеек ВРУЧНУЮ
 
Здравствуйте !
Подскажите, пожалуйста, не могу никак разобраться в этой магии ...
Есть таблица.
Макрос останавливается на удалении отфильтрованных строк по значению "Да" в одном столбце, выдавая сообщение "Команда не применима для перекрывающихся диапазонов". Объединённых ячеек в разделе ленты "Выравнивание" нет (ведь если бы были, то была бы активна строка "Объединить ... )
Если перед запуском макроса вручную "отменяю объединение ячеек" в столбце, то макрос работает.
Если прописываю в макросе Columns("R:R").UnMerge  (на тот момент колонка идёт под буквой R) в начале макроса, или Columns("D:D").UnMerge перед непосредственной фильтрацией столбца — то макрос срабатывает только ОДИН ПЕРВЫЙ раз. Последующие разы удалять отфильтрованные строки не хочет.
Как только вручную перед работой макроса отменяю "объединение ячеек" в столбце — макрос работает.

Что неправильно ? Как так может быть ?

Код
    .................

    Range("D3").AutoFilter Field:=4, Criteria1:="Да" ' Показывает строки в колонке 4, где есть "Да" 
    ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' Удаляет эти строки, начиная со второй строки
    
    .............
Изменено: volh1 - 09.07.2024 12:40:54
 
Приложите проблемный файл
Согласие есть продукт при полном непротивлении сторон
 
Проблемный файл
Изменено: volh1 - 09.07.2024 13:41:14
 
Цитата
volh1 написал:
и макрос работает.
и макроса то никакого в файле нет
Согласие есть продукт при полном непротивлении сторон
 
Извините. Ищу кусок проблемного файла, где не работает макрос.
Изменено: volh1 - 09.07.2024 14:42:42
 
Вы удаляете D:G. А потом ставите фильтр в D3.
Код
Columns("D:G").Delete Shift:=xlToLeft
    
Range("D3").AutoFilter 
Это имело бы смысл, если бы справа от D:G были бы какие-то данные.
Лучше, конечно, прикладывать именно файл, который не работает, а не наспех отредактированную версию.
 
Извиняюсь. Никогда не присоединял раньше макрос к другой книге. Они у меня все в Personal.
Сейчас получилось всё же найти кусок файла, где макрос не хочет работать. Вот он. С макросом.
 
Цитата
написал:
Это имело бы смысл, если бы справа от D:G были бы какие-то данные.
Они есть. Я удаляю ненужные столбцы. А кусок файла, который наконец-то вычленил, где макрос не работает, приложил выше.
 
Код
Option Explicit

Option Compare Text ' Оператор устанавливает нечувствительность к регистру

Sub не_такой_уж_проблемный()
'
' Вершина Шины До Сайта Макрос
'
    
    Columns("A:A").Delete Shift:=xlToLeft
    Range("A1").FormulaR1C1 = "Количество"
    Columns("B:C").Delete Shift:=xlToLeft
    Range("B1").FormulaR1C1 = "Наименование"
    Columns("B:B").ColumnWidth = 50          ' Колонку расширяет до 50 (а то не видно, что в ней)
    Columns("B:B").Replace What:="Автошина ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False ', FormulaVersion:=xlReplaceFormula2  ' Слово "Автошина" с пробелом после неё заменяется на пустоту (таким образом слово удаляется)
    
    Columns("C:I").Delete Shift:=xlToLeft
    Range("C1").FormulaR1C1 = "Сезон"
    Columns("D:G").Delete Shift:=xlToLeft
    
    Range("D3").AutoFilter Field:=4, Criteria1:="Да" ' Показывает строки в колонке 4, где есть "Да" (есть шипы)
    DeleteHiddenRow ActiveSheet.AutoFilter.Range.Offset(1).Row
    'ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' Удаляет эти строки со второй строки
    
    Columns("D:F").Delete Shift:=xlToLeft
    Range("D1").FormulaR1C1 = "Цена"
    Columns("E:E").Delete Shift:=xlToLeft
    Columns("A:A").Cut Destination:=Columns("E:E")
    Columns("A:A").Delete Shift:=xlToLeft
    
    ChDir Environ$("USERPROFILE") & "\Downloads"
    ActiveWorkbook.SaveAs Filename:=("Шины Вершина до сайта " & Format(Date, "D MMM YYYY") & ".xls"), FileFormat:=xlNormal
    
End Sub

Private Sub DeleteHiddenRow(yStart As Long)
    Dim yy As Long
    For yy = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To yStart Step -1
        If Rows(yy).Hidden Then Rows(yy).Delete
    Next
End Sub
 
Погодите. Вы удалили скрытые фильтром строки. А удалить нужно отфильтрованные, то есть оставшиеся.
Мой макрос хорошо работал, пока во входящем файле не появились какие-то перекрывающиеся диапазоны. И если вручную в столбце убрать "объединение", то он снова хорошо и быстро работает.
Не пойму, что за перекрывающиеся диапазоны такие, что их не видно.
Изменено: volh1 - 09.07.2024 15:58:59
 
Код
If Not Rows(yy).Hidden Then Rows(yy).Delete
 
Простите, а зачем так сложно и долго, перебирать каждую строку ? Нужно просто удалить уже отфильтрованные строки и все, без подпрограмм. Там лишь нужно решить вопрос с отменой объединения ячеек. Вручную работает на "ура", а VBA почему-то не делает так, как сам же макрорекодер предлагает.
Изменено: volh1 - 09.07.2024 16:06:08
 
Как минимум очевиден один из ответов - потому что это работает.
 
Да, спасибо, но это работает долго, криво, нерационально совсем. Не лучше ли как-то убрать перекрывающиеся диапазоны ?
 
Вариант побыстрее.
Код
Option Explicit

Option Compare Text ' Оператор устанавливает нечувствительность к регистру

Sub проблемный()
'
    Application.ScreenUpdating = False
    Dim Application_Calculation  As XlCalculation
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual
    
' Вершина Шины До Сайта Макрос
    Columns("A:A").Delete Shift:=xlToLeft
    Range("A1").FormulaR1C1 = "Количество"
    Columns("B:C").Delete Shift:=xlToLeft
    Range("B1").FormulaR1C1 = "Наименование"
    Columns("B:B").ColumnWidth = 50          ' Колонку расширяет до 50 (а то не видно, что в ней)
    Columns("B:B").Replace What:="Автошина ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False ', FormulaVersion:=xlReplaceFormula2  ' Слово "Автошина" с пробелом после неё заменяется на пустоту (таким образом слово удаляется)
    
    Columns("C:I").Delete Shift:=xlToLeft
    Range("C1").FormulaR1C1 = "Сезон"
    Columns("D:G").Delete Shift:=xlToLeft
    
    Range("D3").AutoFilter Field:=4, Criteria1:="Да" ' Показывает строки в колонке 4, где есть "Да" (есть шипы)
    DeleteHiddenRow ActiveSheet.AutoFilter.Range.Offset(1).Row
    'ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' Удаляет эти строки со второй строки
    
    Columns("D:F").Delete Shift:=xlToLeft
    Range("D1").FormulaR1C1 = "Цена"
    Columns("E:E").Delete Shift:=xlToLeft
    Columns("A:A").Cut Destination:=Columns("E:E")
    Columns("A:A").Delete Shift:=xlToLeft
    
    Application.ScreenUpdating = True
    Application.Calculation = Application_Calculation
    
        
    ChDir Environ$("USERPROFILE") & "\Downloads"
    ActiveWorkbook.SaveAs Filename:=("Шины Вершина до сайта " & Format(Date, "D MMM YYYY") & ".xls"), FileFormat:=xlNormal
    
End Sub

Private Sub DeleteHiddenRow(yStart As Long)
    Dim yy As Long
    For yy = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To yStart Step -1
        If Not Rows(yy).Hidden Then Rows(yy).Delete
    Next
End Sub
 
Всем спасибо. вопрос решился: были сдвинуты некоторые столбцы и программа определяла их как скрытые, видать.
Изменено: volh1 - 10.07.2024 18:52:13
Страницы: 1
Наверх