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

Вход

Регистрация

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

 

= Мир MS Excel/Удаление строк с пустыми ячейками - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление строк с пустыми ячейками (Макросы/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
 
Ответить
СообщениеЗдравствуйте!

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

[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]

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

Автор - dyadkin
Дата добавления - 15.03.2022 в 08:43
RAN Дата: Вторник, 15.03.2022, 09:07 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5564
Репутация: 1111 ±
Замечаний: 0% ±

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

Не надо.
[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
 
Ответить
Сообщение
надо просто его дополнить

Не надо.
[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:07
dyadkin Дата: Вторник, 15.03.2022, 09:35 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - dyadkin
Дата добавления - 15.03.2022 в 09:35
RAN Дата: Вторник, 15.03.2022, 09:43 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5564
Репутация: 1111 ±
Замечаний: 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]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[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]

Автор - RAN
Дата добавления - 15.03.2022 в 09:43
dyadkin Дата: Вторник, 15.03.2022, 09:48 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

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


Сообщение отредактировал dyadkin - Вторник, 15.03.2022, 09:50
 
Ответить
СообщениеRAN, попробовал, не удаляются строки теперь которые нужны были

Автор - dyadkin
Дата добавления - 15.03.2022 в 09:48
RAN Дата: Вторник, 15.03.2022, 09:53 | Сообщение № 6
Группа: Друзья
Ранг: Экселист
Сообщений: 5564
Репутация: 1111 ±
Замечаний: 0% ±

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


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеНе видя, что у вас не работает, могу только посочувствовать.

Автор - RAN
Дата добавления - 15.03.2022 в 09:53
msi2102 Дата: Вторник, 15.03.2022, 10:00 | Сообщение № 7
Группа: Проверенные
Ранг: Новичок
Сообщений: 44
Репутация: 30 ±
Замечаний: 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]
К сообщению приложен файл: 5745453.xlsm(16.0 Kb)
 
Ответить
Сообщениеможно ещё так
[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]

Автор - msi2102
Дата добавления - 15.03.2022 в 10:00
dyadkin Дата: Вторник, 15.03.2022, 10:01 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

RAN, вот здесь пример конкретный
К сообщению приложен файл: __2______.xlsm(88.2 Kb)
 
Ответить
СообщениеRAN, вот здесь пример конкретный

Автор - dyadkin
Дата добавления - 15.03.2022 в 10:01
dyadkin Дата: Вторник, 15.03.2022, 10:16 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

msi2102, спасибо большое, добрый человек, сработало!!! hands
 
Ответить
Сообщениеmsi2102, спасибо большое, добрый человек, сработало!!! hands

Автор - dyadkin
Дата добавления - 15.03.2022 в 10:16
msi2102 Дата: Вторник, 15.03.2022, 10:22 | Сообщение № 10
Группа: Проверенные
Ранг: Новичок
Сообщений: 44
Репутация: 30 ±
Замечаний: 0% ±

Excel 2007
сработало

У меня и макрос RAN, сработал
 
Ответить
Сообщение
сработало

У меня и макрос RAN, сработал

Автор - msi2102
Дата добавления - 15.03.2022 в 10:22
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление строк с пустыми ячейками (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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