Показать полную графическую версию : Можно ли удалить ненужные слои структуры?
Возникла проблема, что файл Excel представляет собой структуру в три уровня, раскрывающуюся плюсиками.
Но нужно перемножить два столбца только верхнего уровня с результатом в третьем столбце, так чтобы находящееся в этих двух столбцах в скрытых слоях структуры не участвовало в определении суммы по третьему столбцу.
Но получается, что перемножаются все слои структуры в этих двух столбцах и сумма вычисляется не по видимому верхнему слою структуры, а по всем уровням.
Если удалять структуру имеющейся кнопкой на вкладке Данные, то строки из нижних уровней структуры просто встанут между строками верхнего уровня, мешая.
Можно ли удалить данные только отдельных слоев структуры, хотя чтоб пустые строки остались?
pavsem7, образец Рабочей книги с примерами и наглядными пояснениями приветствуется.
образец Рабочей книги с примерами и наглядными пояснениями приветствуется. »
Прилагаю начальный кусок рабочей книги http://rgho.st/6YJ2gFYcy
Строк в книге много, несколько тысяч, поэтому вручную ничего не получится.
Видно, что колонка Стоимость, которая должна быть произведением Цены на КонРезерв посчитана по разным товарам неправильно, некоторые клетки вообще пустые, в 15-ой строке результат завышен и т.п. Подсчет результата(итога) по колонке Стоимость нужен только по верхнему слою, а спрятанные слои под крестиками, т.е., например, строки 16, 17, 19,20,21,23,24 и т.д. не должны давать слагаемых в эту сумму. Если же просто перемножить столбцы Цена и КонРезерв, то эти спрятанные строки дают слагаемые, сумма по товарам получается завышенной.
Цель - удалить нижние слои из книги, т.е. те самые спрятанные строки. Тогда итог стоимости правильно посчитается.
pavsem7, а нельзя ли то же, но с формулами?
Достаточно странная организация структуры…
Вы уверены, что речь про первый уровень структуры? Там ровно две строки, и обе с пустым содержимым в искомых ячейках. Вот для второго уровня структуры:
Option Explicit
Sub Sample()
Dim objRange As Range
For Each objRange In ThisWorkbook.Worksheets.Item("TDSheet").Range("G6:G117").Cells
Debug.Print objRange.Address, objRange.Rows.Item(1).OutlineLevel
If objRange.Rows.Item(1).OutlineLevel = 2 Then
objRange.Value = objRange.Offset(0, -2).Value * objRange.Offset(0, -1).Value
Else
objRange.ClearContents
End If
Next
End Sub
Можно и формулой.
Это то, что Вы хотели? Главный вопрос — в определении размеров диапазона (в примере — «G6:G117») на реальных данных, «ручками» ведь не будете задавать всякий раз. На что можем ориентироваться?
pavsem7, а нельзя ли то же, но с формулами? »
Сдаётся мне, что это явно результат выгрузки из какой-то внешней программы. И, по-хорошему, править надо код там.
Это то, что Вы хотели? Главный вопрос — в определении размеров диапазона (в примере — «G6:G117») на реальных данных, «ручками» ведь не будете задавать всякий раз. На что можем ориентироваться? »
Спасибо, работает. Да, надо на 2 уровне считать и до ячейки G122, придется вручную.
Почему Вы называете лист TDSheet?
pavsem7, а нельзя ли то же, но с формулами? »
Сдаётся мне, что это явно результат выгрузки из какой-то внешней программы. И, по-хорошему, править надо код там. »
Это выгрузка из 1С8.2 СКД, там формул нет, все галочками настраивается, а те, что есть, считают неправильно. Разбирался несколько дней, не понять, почему не считает.
А результат начальству быстрее нужен.
У меня попутный вопрос по применению: я записал Вашу процедуру в макрос и запустил, при этом файл надо сохранять как xlsm.
Но можно ли запускать этот макрос-процедуру внешним образом, чтоб просто обрабатывать файл xlsx, а внутри процедура не хранилась?
можно ли запускать этот макрос-процедуру внешним образом »
Как создать свою надстройку? (http://www.excel-vba.ru/chto-umeet-excel/kak-sozdat-svoyu-nadstrojku/)
Почему Вы называете лист TDSheet? »
Потому что таково его имя. Ухватитесь за разделитель-ползунок:
http://i.imgur.com/mIJ6KN2.png
(когда курсор мышки примет двунаправленную форму) и тяните его вправо — сами увидите.
Это выгрузка из 1С8.2 »
Я так и предполагал, что 1С. Родимые пятна — ничего, зараза, не изменилось :(.
там формул нет, все галочками настраивается, а те, что есть, считают неправильно. »
Там надо в саму обработку, в код лезть и править, как я понимаю.
У меня попутный вопрос по применению: я записал Вашу процедуру в макрос и запустил, при этом файл надо сохранять как xlsm.
Но можно ли запускать этот макрос-процедуру внешним образом, чтоб просто обрабатывать файл xlsx, а внутри процедура не хранилась? »
Можно. Вроде как хранитель персональных макросов Personal.xls всё ещё работает в новых версиях Office в виде Personal.xlsm. Только поменяйте в коде «ThisWorkbook» на «ActiveWorkbook».
придется вручную. »
Это не дело. Всё же подумайте: каким образом, по каким признакам коду следует определять границы обрабатываемого диапазона.
Там надо в саму обработку, в код лезть и править, как я понимаю. »
Там кода нет, кроме a*b, все настраивается через GUI, а если не настраивается, то надо писать в дополнение код более ветвистый чем в VBA.
Можно. Вроде как хранитель персональных макросов Personal.xls всё ещё работает в новых версиях Office в виде Personal.xlsm. Только поменяйте в коде «ThisWorkbook» на «ActiveWorkbook». »
Я думал есть, что-нибудь типа командной строки excel file.xlsx /key macros.vbs ? Чтоб постоянно не хранилось.
придется вручную. »
Это не дело. Всё же подумайте: каким образом, по каким признакам коду следует определять границы обрабатываемого диапазона. »
Граница очевидна - первая пустая строка, но макрос работает, даже если вручную задать заведомо завышенную верхнюю границу G10000.
Там кода нет, кроме a*b, »
В сказки не верю, коллега.
то надо писать в дополнение код более ветвистый чем в VBA. »
С этим не спорю.
Я думал есть, что-нибудь типа командной строки excel file.xlsx /key macros.vbs ? Чтоб постоянно не хранилось. »
Нету.
Граница очевидна - первая пустая строка, »
Это нижняя. А верхняя граница? И всегда ли это будет столбец «G», а не какой-либо другой?!
Там кода нет, кроме a*b, »
В сказки не верю, коллега. »
Не сказки, это 1с8 СКД, специальное встроенное графическое приложение для создания отчетов без кода, кода там нет, кроме цена*кол-во.
Граница очевидна - первая пустая строка, »
Это нижняя. А верхняя граница? И всегда ли это будет столбец «G», а не какой-либо другой?! »
Верхняя всегда G6. Столбец всегда устанавливается в G.
pavsem7, код там таки есть, но он заботливо скрыт от пользователя :).
Верхняя всегда G6. Столбец всегда устанавливается в G. »
Давайте попробуем так:
Option Explicit
Sub Sample()
Dim objRange As Range
If IsWorksheetExists("TDSheet") Then
With ActiveWorkbook.Worksheets.Item("TDSheet")
For Each objRange In Intersect(.UsedRange, .Range("G6:G65536")).Cells
If objRange.Rows.Item(1).OutlineLevel = 2 Then
'objRange.Value = objRange.Offset(0, -2).Value * objRange.Offset(0, -1).Value
objRange.Formula = "=" & objRange.Offset(0, -2).Address & "*" & objRange.Offset(0, -1).Address
Else
objRange.ClearContents
End If
Next objRange
End With
Else
MsgBox "Can't find worksheet named [TDSheet] in active workbook", vbInformation + vbOKOnly
End If
End Sub
Private Function IsWorksheetExists(strWorksheetName As String) As Boolean
Dim objWorksheet As Worksheet
IsWorksheetExists = False
For Each objWorksheet In ActiveWorkbook.Worksheets
If StrComp(objWorksheet.Name, strWorksheetName, vbTextCompare) = 0 Then
IsWorksheetExists = True
Exit For
End If
Next objWorksheet
End Function
Добавил проверку существования в активной Рабочей книге Рабочего листа с указанным именем, и сделал добавление формулы:
колонка Стоимость, которая должна быть произведением Цены на КонРезерв »
вместо готового значения (старый вариант там же выше, закомментирован).
pavsem7, может имеет смысл сделать код не в Excel, а во внешнем скрипте? Тогда сможете, скажем, банально перетаскивать на скрипт (или на ярлык на скрипт) потребный файл Рабочей книги в Проводнике, использовать его запуск из Планировщика, пакетного файла или же непосредственно из 1С (если экспорт этого отчёта 1C в Рабочую книгу у Вас делается программно).
Добавил проверку существования в активной Рабочей книге Рабочего листа с указанным именем, и сделал добавление формулы »
Не понимаю смысла совершать эту проверку. Такой лист создался при сохранении из 1С автоматически, я даже не знал его названия, пока Вы не подсказали. Отчеты из 1С, насколько я понял, всегда сохраняются в однолистовую книгу. В принципе могут быть отчеты совсем о другом, но по-видимому, с тем же именем.
может имеет смысл сделать код не в Excel, а во внешнем скрипте? Тогда сможете, скажем, банально перетаскивать на скрипт (или на ярлык на скрипт) »
А вот это интересно. Это как раз типа командной строки. Только я не понял, как сделать скрипт, чтоб при его перетаскивании на файл Excel этот файл Excel обрабатывался?
Мне годится тот короткий скрипт, который был раньше.
Не понимаю смысла совершать эту проверку. »
Запустили макрос в Рабочей книге, в которой нет данного листа (случайно, специально, звёзды так сошлись — не суть важно). Без этой проверки макрос отвалится с ошибкой времени исполнения, с проверкой — просто сообщит об отсутствии листа.
но по-видимому, с тем же именем. »
Не уверен.
А вот это интересно. Это как раз типа командной строки. Только я не понял, как сделать скрипт, чтоб при его перетаскивании на файл Excel этот файл Excel обрабатывался? »
Попробуйте так (WSH):
Option Explicit
Dim strSourceFile
Dim objWorksheet
Dim objRange
If WScript.Arguments.Count = 1 Then
With WScript.CreateObject("Scripting.FileSystemObject")
strSourceFile = .GetAbsolutePathName(WScript.Arguments.Item(0))
If .FileExists(strSourceFile) Then
Select Case LCase(.GetExtensionName(strSourceFile))
Case "xls", "xlsx"
With WScript.CreateObject("Excel.Application")
With .Workbooks.Open(strSourceFile)
For Each objWorksheet In .Worksheets
With objWorksheet
If StrComp(.Name, "TDSheet", vbTextCompare) = 0 Then
For Each objRange In .Parent.Parent.Intersect(.UsedRange, .Range("G6:G65536")).Cells
If objRange.Rows.Item(1).OutlineLevel = 2 Then
objRange.Formula = "=" & objRange.Offset(0, -2).Address & "*" & objRange.Offset(0, -1).Address
Else
objRange.ClearContents
End If
Next
Exit For
End If
End With
Next
.Save
.Close
End With
.Quit
End With
Case Else
WScript.Echo "Probably not an Excel workbook."
WScript.Quit 3
End Select
Else
WScript.Echo "Can't find source file [" & strSourceFile & "]."
WScript.Quit 2
End If
End With
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file>"
WScript.Quit 1
End If
WScript.Quit 0
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.
Available in ZeroNet 1osznRoVratMCN3bFoFpR2pSV5c9z6sTC