Страницы: 1
RSS
Удаление пустых ячеек с условием
 
Есть данные по товарами, с количеством и ценами по размерным рядам. Обычным способом удалять мешают ячейки с размерами. В примере вручную сделал, как в итоге должно выглядеть. Строк товара тысячи, в одной строке могут быть разные размеры
 
Sharmat, так как
Цитата
Sharmat написал:
Строк товара тысячи
объясните по порядку как  что перемещать и что удалять...т.е. берем то ставим туда + прибавляем это, остальное удаляем...
у Вас получается если нет кол-ва нужно удалить?!
сделал как понял
Код
Sub dsd()
Dim i As Double
Dim n As Double
Worksheets("Нужно").Range("A2", ActiveCell.SpecialCells(xlLastCell)).ClearContents
Application.ScreenUpdating = False

    For i = 2 To Worksheets("Дано").Cells(Rows.Count, 1).End(xlUp).Row
        ilastrow = Worksheets("Нужно").Cells(Rows.Count, 1).End(xlUp).Row + 1
        For n = 3 To Worksheets("Дано").Cells(i, Columns.Count).End(xlUp).Column Step 3
        If Worksheets("Дано").Cells(i, n) <> "" Then
        ilastcol = Worksheets("Нужно").Cells(ilastrow, Columns.Count).End(xlToLeft).Column + 1
        Worksheets("Нужно").Cells(ilastrow, 1) = Worksheets("Дано").Cells(i, 1)
        Worksheets("Нужно").Cells(ilastrow, ilastcol) = Worksheets("Дано").Cells(i, n - 1)
        Worksheets("Нужно").Cells(ilastrow, ilastcol + 1) = Worksheets("Дано").Cells(i, n)
        Worksheets("Нужно").Cells(ilastrow, ilastcol + 2) = Worksheets("Дано").Cells(i, n + 1)
        End If
        Next n
    Next i
    
Application.ScreenUpdating = True
End Sub
Изменено: Mershik - 01.04.2020 15:11:44
Не бойтесь совершенства. Вам его не достичь.
 
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim iLastCol As Integer
Dim j As Integer
Application.ScreenUpdating = False
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 iLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  For i = 2 To iLastRow
    For j = iLastCol To 4 Step -3
      If WorksheetFunction.CountA(Range(Cells(i, j - 2), Cells(i, j))) <> 3 Then
        Range(Cells(i, j - 2), Cells(i, j)).Delete shift:=xlToLeft
      End If
    Next
  Next
Application.ScreenUpdating = True
End Sub
 
Mershik, Kuzmich, спасибо, не понимаю, как конкретно они делают но оба макроса дают результат.
Mershik,  самая лаконичная и правильная формулировка, наверное, будет такая: Если ячейка в столбце с подзаголовком содержащим текст "цена" пустая - удаляется она и две ячейки справа от нее, со сдвигом влево.
Kuzmich, в прошлом сообщении что-то сказали про "неответ". Предполагаю, я когда-то на одной из тем не отреагировал на ваше сообщение. Наверное, забыл подписаться на новые сообщения. Если Вы тогда потратили время на помощь мне, то спасибо и извините, что не увидел или забыл ответить.
Страницы: 1
Наверх