Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)
-   -   Можно ли удалить ненужные слои структуры? (http://forum.oszone.net/showthread.php?t=317317)

pavsem7 30-07-2016 00:36 2655439
Можно ли удалить ненужные слои структуры?
 
Возникла проблема, что файл Excel представляет собой структуру в три уровня, раскрывающуюся плюсиками.
Но нужно перемножить два столбца только верхнего уровня с результатом в третьем столбце, так чтобы находящееся в этих двух столбцах в скрытых слоях структуры не участвовало в определении суммы по третьему столбцу.
Но получается, что перемножаются все слои структуры в этих двух столбцах и сумма вычисляется не по видимому верхнему слою структуры, а по всем уровням.

Если удалять структуру имеющейся кнопкой на вкладке Данные, то строки из нижних уровней структуры просто встанут между строками верхнего уровня, мешая.

Можно ли удалить данные только отдельных слоев структуры, хотя чтоб пустые строки остались?

Iska 30-07-2016 06:20 2655459
pavsem7, образец Рабочей книги с примерами и наглядными пояснениями приветствуется.

pavsem7 30-07-2016 14:45 2655511
Цитата:
Цитата Iska
образец Рабочей книги с примерами и наглядными пояснениями приветствуется. »
Прилагаю начальный кусок рабочей книги http://rgho.st/6YJ2gFYcy

Строк в книге много, несколько тысяч, поэтому вручную ничего не получится.
Видно, что колонка Стоимость, которая должна быть произведением Цены на КонРезерв посчитана по разным товарам неправильно, некоторые клетки вообще пустые, в 15-ой строке результат завышен и т.п. Подсчет результата(итога) по колонке Стоимость нужен только по верхнему слою, а спрятанные слои под крестиками, т.е., например, строки 16, 17, 19,20,21,23,24 и т.д. не должны давать слагаемых в эту сумму. Если же просто перемножить столбцы Цена и КонРезерв, то эти спрятанные строки дают слагаемые, сумма по товарам получается завышенной.

Цель - удалить нижние слои из книги, т.е. те самые спрятанные строки. Тогда итог стоимости правильно посчитается.

okshef 30-07-2016 23:15 2655618
pavsem7, а нельзя ли то же, но с формулами?

Iska 31-07-2016 02:16 2655636
Достаточно странная организация структуры…

Вы уверены, что речь про первый уровень структуры? Там ровно две строки, и обе с пустым содержимым в искомых ячейках. Вот для второго уровня структуры:
Код:
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») на реальных данных, «ручками» ведь не будете задавать всякий раз. На что можем ориентироваться?

Цитата:
Цитата okshef
pavsem7, а нельзя ли то же, но с формулами? »
Сдаётся мне, что это явно результат выгрузки из какой-то внешней программы. И, по-хорошему, править надо код там.

pavsem7 31-07-2016 11:27 2655678
Цитата:
Цитата Iska
Это то, что Вы хотели? Главный вопрос — в определении размеров диапазона (в примере — «G6:G117») на реальных данных, «ручками» ведь не будете задавать всякий раз. На что можем ориентироваться? »
Спасибо, работает. Да, надо на 2 уровне считать и до ячейки G122, придется вручную.
Почему Вы называете лист TDSheet?

Цитата:
Цитата Iska
pavsem7, а нельзя ли то же, но с формулами? »
Сдаётся мне, что это явно результат выгрузки из какой-то внешней программы. И, по-хорошему, править надо код там. »
Это выгрузка из 1С8.2 СКД, там формул нет, все галочками настраивается, а те, что есть, считают неправильно. Разбирался несколько дней, не понять, почему не считает.
А результат начальству быстрее нужен.

У меня попутный вопрос по применению: я записал Вашу процедуру в макрос и запустил, при этом файл надо сохранять как xlsm.
Но можно ли запускать этот макрос-процедуру внешним образом, чтоб просто обрабатывать файл xlsx, а внутри процедура не хранилась?

okshef 31-07-2016 14:18 2655711
Цитата:
Цитата pavsem7
можно ли запускать этот макрос-процедуру внешним образом »
Как создать свою надстройку?

Iska 31-07-2016 18:53 2655777
Цитата:
Цитата pavsem7
Почему Вы называете лист TDSheet? »
Потому что таково его имя. Ухватитесь за разделитель-ползунок:



(когда курсор мышки примет двунаправленную форму) и тяните его вправо — сами увидите.

Цитата:
Цитата pavsem7
Это выгрузка из 1С8.2 »
Я так и предполагал, что 1С. Родимые пятна — ничего, зараза, не изменилось :(.

Цитата:
Цитата pavsem7
там формул нет, все галочками настраивается, а те, что есть, считают неправильно. »
Там надо в саму обработку, в код лезть и править, как я понимаю.

Цитата:
Цитата pavsem7
У меня попутный вопрос по применению: я записал Вашу процедуру в макрос и запустил, при этом файл надо сохранять как xlsm.
Но можно ли запускать этот макрос-процедуру внешним образом, чтоб просто обрабатывать файл xlsx, а внутри процедура не хранилась? »
Можно. Вроде как хранитель персональных макросов Personal.xls всё ещё работает в новых версиях Office в виде Personal.xlsm. Только поменяйте в коде «ThisWorkbook» на «ActiveWorkbook».

Цитата:
Цитата pavsem7
придется вручную. »
Это не дело. Всё же подумайте: каким образом, по каким признакам коду следует определять границы обрабатываемого диапазона.

pavsem7 03-08-2016 15:42 2656535
Цитата:
Цитата Iska
Там надо в саму обработку, в код лезть и править, как я понимаю. »
Там кода нет, кроме a*b, все настраивается через GUI, а если не настраивается, то надо писать в дополнение код более ветвистый чем в VBA.

Цитата:
Цитата Iska
Можно. Вроде как хранитель персональных макросов Personal.xls всё ещё работает в новых версиях Office в виде Personal.xlsm. Только поменяйте в коде «ThisWorkbook» на «ActiveWorkbook». »
Я думал есть, что-нибудь типа командной строки excel file.xlsx /key macros.vbs ? Чтоб постоянно не хранилось.


Цитата:
Цитата Iska
придется вручную. »
Это не дело. Всё же подумайте: каким образом, по каким признакам коду следует определять границы обрабатываемого диапазона. »
Граница очевидна - первая пустая строка, но макрос работает, даже если вручную задать заведомо завышенную верхнюю границу G10000.

Iska 03-08-2016 18:50 2656597
Цитата:
Цитата pavsem7
Там кода нет, кроме a*b, »
В сказки не верю, коллега.

Цитата:
Цитата pavsem7
то надо писать в дополнение код более ветвистый чем в VBA. »
С этим не спорю.

Цитата:
Цитата pavsem7
Я думал есть, что-нибудь типа командной строки excel file.xlsx /key macros.vbs ? Чтоб постоянно не хранилось. »
Нету.

Цитата:
Цитата pavsem7
Граница очевидна - первая пустая строка, »
Это нижняя. А верхняя граница? И всегда ли это будет столбец «G», а не какой-либо другой?!

pavsem7 04-08-2016 13:11 2656823
Цитата:
Цитата Iska
Там кода нет, кроме a*b, »
В сказки не верю, коллега. »
Не сказки, это 1с8 СКД, специальное встроенное графическое приложение для создания отчетов без кода, кода там нет, кроме цена*кол-во.

Цитата:
Цитата Iska
Граница очевидна - первая пустая строка, »
Это нижняя. А верхняя граница? И всегда ли это будет столбец «G», а не какой-либо другой?! »
Верхняя всегда G6. Столбец всегда устанавливается в G.

Iska 05-08-2016 06:52 2657017
pavsem7, код там таки есть, но он заботливо скрыт от пользователя :).

Цитата:
Цитата 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
колонка Стоимость, которая должна быть произведением Цены на КонРезерв »
вместо готового значения (старый вариант там же выше, закомментирован).


pavsem7, может имеет смысл сделать код не в Excel, а во внешнем скрипте? Тогда сможете, скажем, банально перетаскивать на скрипт (или на ярлык на скрипт) потребный файл Рабочей книги в Проводнике, использовать его запуск из Планировщика, пакетного файла или же непосредственно из 1С (если экспорт этого отчёта 1C в Рабочую книгу у Вас делается программно).

pavsem7 07-08-2016 12:25 2657576
Цитата:
Цитата Iska
Добавил проверку существования в активной Рабочей книге Рабочего листа с указанным именем, и сделал добавление формулы »
Не понимаю смысла совершать эту проверку. Такой лист создался при сохранении из 1С автоматически, я даже не знал его названия, пока Вы не подсказали. Отчеты из 1С, насколько я понял, всегда сохраняются в однолистовую книгу. В принципе могут быть отчеты совсем о другом, но по-видимому, с тем же именем.

Цитата:
Цитата Iska
может имеет смысл сделать код не в Excel, а во внешнем скрипте? Тогда сможете, скажем, банально перетаскивать на скрипт (или на ярлык на скрипт) »
А вот это интересно. Это как раз типа командной строки. Только я не понял, как сделать скрипт, чтоб при его перетаскивании на файл Excel этот файл Excel обрабатывался?
Мне годится тот короткий скрипт, который был раньше.

Iska 08-08-2016 08:26 2657729
Цитата:
Цитата pavsem7
Не понимаю смысла совершать эту проверку. »
Запустили макрос в Рабочей книге, в которой нет данного листа (случайно, специально, звёзды так сошлись — не суть важно). Без этой проверки макрос отвалится с ошибкой времени исполнения, с проверкой — просто сообщит об отсутствии листа.

Цитата:
Цитата pavsem7
но по-видимому, с тем же именем. »
Не уверен.

Цитата:
Цитата pavsem7
А вот это интересно. Это как раз типа командной строки. Только я не понял, как сделать скрипт, чтоб при его перетаскивании на файл 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


Время: 22:20.

Время: 22:20.
© OSzone.net 2001-