Если ячейка пуста, то строку вниз

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

Если ячейка пуста, то строку вниз (Макросы/Sub)

Yar4i

Дата: Вторник, 31.01.2017, 17:33 | Сообщение № 1

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

Ранг: Форумчанин

Сообщений: 138

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

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

Excel 2010

Добрый вечер дамы и господа

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

Код

Dim x, y(), m&, j&, k&, N&, s$
                x = Range("A20:L" & Cells(Rows.Count, 2).End(xlUp).Row + 1).Value
                ReDim y(1 To UBound(x), 1 To UBound(x, 2))
                On Error Resume Next
                With New Collection
                    For m = 1 To UBound(x)
                        s = x(m, 2) & "~" & x(m, 3)
                        If IsEmpty(.Item(s)) Then
                            k = k + 1
                            For j = 1 To UBound(x, 2)
                    y(k, j) = x(m, j)
                            Next j
                            .Add Item:=k, Key:=s
                        Else
                            N = .Item(s)
                            y(N, 4) = y(N, 4) + x(m, 4)
                        End If
                    Next m
                End With
                With Range("A20:L" & Cells(Rows.Count, 2).End(xlUp).Row + 1)
                 .ClearContents: .Resize(k).Value = y()
                End With

[/vba]

Добрый вечер дамы и господа

Код

[/vba]Yar4i

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

Ответить

СообщениеДобрый вечер дамы и господа

Код

[/vba]

Автор - Yar4i
Дата добавления - 31.01.2017 в 17:33

Kamikadze_N

Дата: Среда, 01.02.2017, 11:45 | Сообщение № 2

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

Ранг: Участник

Сообщений: 75

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

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

Excel 2010

Yar4i, а это должно происходить автоматически при добавлении новой строки или по нажатию клавиши обновить?

Ответить

K-SerJC

Дата: Среда, 01.02.2017, 11:57 | Сообщение № 3

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

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

Сообщений: 487

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

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

Excel 2013

так?
[vba]

Код

Sub RowsRestr()
Dim nstr As Collection, lr, wb, sh, f, k
wb = ActiveWorkbook.Name
sh = ActiveSheet.Name
lr = Workbooks(wb).Sheets(sh).Cells(Rows.Count, 1).End(xlUp).Row
Set nstr = New Collection
For f = 20 To lr
If Workbooks(wb).Sheets(sh).Cells(f, 9).Value = "" Then nstr.Add f
Next f
k = 0
For f = 1 To nstr.Count
Rows(nstr(f) - k).Cut
Rows(lr + 1).Insert Shift:=xlDown
k = k + 1
Next f

End Sub

[/vba]