Удаление строк с пустыми ячейками

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Удаление строк с пустыми ячейками (Макросы/Sub)

dyadkin

Дата: Вторник, 15.03.2022, 08:43 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 0% ±

Здравствуйте!

Подскажите, пожалуйста, какой код дописать, чтобы решить эту задачу:
В кратце: Есть два столбца (артикул и цена), и в какой-то из строк есть артикул, но нет цены, и наоборот (пример прикреплен). Надо, чтобы с помощью макроса, удалялись эти строки со смещение вверх (смог сделать, чтобы удалялась пустая ячейка, но это не то, надо чтобы целая строка, чтобы не сползли данные)
Есть вот такой макрос, надо просто его дополнить с вот этой функцией описанной выше:

[vba]

Код

Sub Макрос1()
'
' Макрос1 Макрос
'

'
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Range("C2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+RC[-1]*R1C4"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C1000"), Type:=xlFillDefault
Range("C2:C1000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("C").Replace What:="0", Replacement:="", LookAt:=xlWhole
End Sub

[/vba]

Заранее спасибо!

К сообщению приложен файл: 5745453.xlsx (9.1 Kb)

Сообщение отредактировал dyadkin - Вторник, 15.03.2022, 08:45

Ответить

RAN

Дата: Вторник, 15.03.2022, 09:07 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Цитата dyadkin, 15.03.2022 в 08:43, в сообщении № 1 (

)

надо просто его дополнить

Не надо.
[vba]

Код

Sub qq()
    Dim lr&, r As Range
    lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    On Error Resume Next
    Set r = Range(Cells(2, 1), Cells(lr, 2)).SpecialCells(xlCellTypeBlanks)
    r.EntireRow.Delete
    On Error GoTo 0
    lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Set r = Range(Cells(2, 3), Cells(lr, 3))
    r.FormulaR1C1 = "=RC[-1]+RC[-1]*R1C4"
    r.Value = r.Value
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Вторник, 15.03.2022, 09:24

Ответить

dyadkin

Дата: Вторник, 15.03.2022, 09:35 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 0% ±

RAN, а если ячейка содержит одиночный "0", как можно тоже ее убрать вместе со строкой?

Ответить

RAN

Дата: Вторник, 15.03.2022, 09:43 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Sub qq()
    Dim lr&, r As Range
    lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range(Cells(2, 1), Cells(lr, 2)).Replace What:=0, Replacement:=Empty, LookAt:=xlWhole
    On Error Resume Next
    Set r = Range(Cells(2, 1), Cells(lr, 2)).SpecialCells(xlCellTypeBlanks)
    r.EntireRow.Delete
    On Error GoTo 0
    lr = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Set r = Range(Cells(2, 3), Cells(lr, 3))
    r.FormulaR1C1 = "=RC[-1]+RC[-1]*R1C4"
    r.Value = r.Value
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

dyadkin

Дата: Вторник, 15.03.2022, 09:48 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 0% ±

RAN, попробовал, не удаляются строки теперь которые нужны были

Сообщение отредактировал dyadkin - Вторник, 15.03.2022, 09:50

Ответить

RAN

Дата: Вторник, 15.03.2022, 09:53 | Сообщение № 6

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Не видя, что у вас не работает, могу только посочувствовать.

Быть или не быть, вот в чем загвоздка!

Ответить

msi2102

Дата: Вторник, 15.03.2022, 10:00 | Сообщение № 7

Группа: Проверенные

Ранг: Обитатель

Сообщений: 415

Репутация: 129 ±

Замечаний: 0% ±

Excel 2007

можно ещё так
[vba]

Код

Sub Макрос2()
    Dim r As Long, rng As Range
    arr = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
    For r = 1 To UBound(arr)
        If arr(r, 1) = "" Or arr(r, 2) = "" Or arr(r, 1) = 0 Or arr(r, 2) = 0 Then
            If rng Is Nothing Then
                Set rng = Rows(r + 1)
            Else
                Set rng = Union(rng, Rows(r + 1))
            End If
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete
    Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = "=RC[-1]+RC[-1]*R1C4"
End Sub

[/vba]