Цель - вытащить массив данных, на новый Лист, где Остаток склада по Номенклатуре равен Пусто либо Ноль. Для дальнейших работ по распределению товарных запасов.
Необходимо: По Листу Исх - это Остатки склада по Номенклатурно, я Макросом (который прилагаю по тексту в Листе Макрос) произвожу переворот таблицы, выход на Листе Достичь коллонки А,В,С.
Далее,
необходимо допилить макрос таким образом, что бы массив данных привести к правилу Остаток склада по Номенклатуре равен Пусто либо Ноль, пример того, что должно получиться представлено на Листе Достичь коллонки H,I,J. Тобишь удалить строки, где Склад+Номенклатура >=1.
Пример прилагаю.
Цель - вытащить массив данных, на новый Лист, где Остаток склада по Номенклатуре равен Пусто либо Ноль. Для дальнейших работ по распределению товарных запасов.
Необходимо: По Листу Исх - это Остатки склада по Номенклатурно, я Макросом (который прилагаю по тексту в Листе Макрос) произвожу переворот таблицы, выход на Листе Достичь коллонки А,В,С.
Далее,
необходимо допилить макрос таким образом, что бы массив данных привести к правилу Остаток склада по Номенклатуре равен Пусто либо Ноль, пример того, что должно получиться представлено на Листе Достичь коллонки H,I,J. Тобишь удалить строки, где Склад+Номенклатура >=1.Snake1501
Sub Мяу() Dim i As Long Dim hc As Integer, hr As Integer Dim ns As Worksheet
hr = InputBox("""Сколько строк с подписями сверху?""") hc = InputBox("""Сколько столбцов с подписями слева?""")
Application.ScreenUpdating = False
i = 1 Set inpdata = Selection Set ns = Worksheets.Add
For r = (hr + 1) To inpdata.Rows.Count For c = (hc + 1) To inpdata.Columns.Count For j = 1 To hc If inpdata.Cells(r, c) = "" Then ns.Cells(i, j) = inpdata.Cells(r, j) For k = 1 To hr ns.Cells(i, j + k) = inpdata.Cells(k, c) Next k ns.Cells(i, j + k) = inpdata.Cells(r, c) i = i + 1 End If Next j Next c Next r Application.ScreenUpdating = True
End Sub
[/vba]
[vba]
Код
Sub Мяу() Dim i As Long Dim hc As Integer, hr As Integer Dim ns As Worksheet
hr = InputBox("""Сколько строк с подписями сверху?""") hc = InputBox("""Сколько столбцов с подписями слева?""")
Application.ScreenUpdating = False
i = 1 Set inpdata = Selection Set ns = Worksheets.Add
For r = (hr + 1) To inpdata.Rows.Count For c = (hc + 1) To inpdata.Columns.Count For j = 1 To hc If inpdata.Cells(r, c) = "" Then ns.Cells(i, j) = inpdata.Cells(r, j) For k = 1 To hr ns.Cells(i, j + k) = inpdata.Cells(k, c) Next k ns.Cells(i, j + k) = inpdata.Cells(r, c) i = i + 1 End If Next j Next c Next r Application.ScreenUpdating = True