» Excel VBA (часть 3)

aidomars ?

Цитата:

просто сравниваются два рядомстоящих числа

Дык, а у меня что сравнивается? Те же два соседних... Я так и не уловил - в чем простота?

Да и, разве _это_ "проще", когда _в_каждом_цикле_:

- три ветвления if;
- три раза вычисляется 'vArr(i) - vArr(i - 1)';
- три раза вычисляется 'vArr(i + 1) - vArr(i)';
- два раза сравнивается 'vArr(i + 1) - vArr(i) <> 1';
- два раза сравнивается 'vArr(i) - vArr(i - 1) <> 1';

и, плюсом:
- один if до цикла и еще один после.

Ну и, в довершение всего, не работает... :(
Работает все, работает :)

asbo
Ну на скорую руку так вышло ifы везде, где не работает то?
А простоту определяю так: если писать комментарии, то чем меньше их тем проще имхо.

Цитата:

где не работает то?

Так картинка же с твоего бокса :)
5, 7, 23 - лишние.

Цитата:

А простоту определяю так: если писать комментарии, то чем меньше их тем проще имхо.

Какие комментарии?... оба кода голые... Да и критерий простоты странный :)

Цитата:

5, 7, 23 - лишние.

Посмотри оригинал, где же лишние, все по заказу)
Насчет простоты - написал же "имхо", не придерешься)

aidomars

Цитата:

где же лишние, все по заказу

Действительно, перечел ТЗ - все верно. Забираю свои слова взад.
Это я почему-то решил, что нужны только смежные. У меня только их выводит.

asbo
aidomars
Ребята, расслабьтесь Оба варианта хороши.

Второй вариант конечно ближе к ТЗ. Так как выводяться все заданые числа + в нужной формате (1 число на строку или 2 границы последовательности в строке).

Но оба варианта имеют плюс - они оставляют и мне немного работы по заврешению решения.

Всем спасибо!

Dmitriy05

Уж полночь близится... Вот и славно, что переписывать не надо :)
А то мы тут чуть вторую страницу не перелистнули :)

Re
ozioso

Цитата:

В данном случае уровни отображаются через Indent

По картинке не видно, как и чем организован отступ. Если это действительно Indent, то его можно дополнительно использовать для проверки корректности определения поля через OutlineLevel или наоборот.

Добавлено:
Щфз ф-цию пользовательскую набросаю.

Задача:
Есть Книга Excel. Можно ли выделить листы и показать меню печати (и по возможности выбрать вариант "выделенные листы")?

Почему не вывести листы по-отдельности и почему не выести на указанный принтер сразу?
Ответ:
Печатать на принтер требуют с паролем (защишенная печать) поэтому проще сделать одним заданием. Вывести же сразу на печать не могу - нужно установить пароль + иногда эта настройка сбиваеться если открывать/закрывать excel.

ozioso

Код:
Public Function fn_Outline2Columns(pRng As Range, pLvl%)
'Stop
Select Case pRng.Rows.OutlineLevel = pLvl
Case True
fn_Outline2Columns = pRng.Value
Case False
'
End Select
End Function

asbo
Большое спасибо за ответ!

Однако я только пользователь. Подскажи еще, пожалуйста, какие дополнительные действия нужно совершить, чтобы функция сработала? Создать макрос и внести туда этот код я смогу. Какие-то дополнительные действия нужны для использования функции?

ozioso

Цитата:

Создать макрос и внести туда этот код я смогу

Ну-у! Отлично. Значит полдела уже сделано :)
Проект надо будет сохранить и скомпилировать Debug - Compile
После этого функция будет видна на листе. Нажав на fx в строке редактирования, выбрать Определенные пользователем, там выбрать эту. Первым аргументом в нее подставляем ссылку на проверяемую ячейку, а вторым - номер уровня. Если ячейка находится именно на этом уровне, то будет выведено ее значение. Ну, это только демонстрация метода, подхода.

asbo
Огромное спасибо, искомый результат достигнут! Кручу-верчу пивотом!

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

Код:
Sub Outline2Columns()
Dim rSrc As Range, rCell As Range
Dim dPrc#
Dim lTov& ' Changed iTov% to lTov&
Dim iShf%, i%, iLvl%, iOut%
Dim vLbl() As Variant
Set rSrc = Range("B5:B19") ' User - Source data
iOut = 4 ' User - Max Outline Level
iShf = 4 ' User - No of columns to offset result ddata

iOut = iOut + 1
ReDim vLbl(1 To iOut)
For Each rCell In rSrc
With rCell
iLvl = .Rows.OutlineLevel
vLbl(iLvl) = .Value
Select Case iLvl
Case iOut - 1
lTov = lTov + 1
vLbl(iOut) = .Offset(0, 1).Value
For i = 1 To iOut
Cells(lTov, i + iShf).Value = vLbl(i)
Next
Case Is >= iOut
Stop
End Select
End With
Next
End Sub

asbo
Я пока одно ограничение нашел для той функции - человеко-часы - для обработки 80 тысяч строк мне понадобился где-то час, чтобы фильтрами и функциями получить нужный сорс для пивота.

Осталась пара файлов по 200 и 300 тысяч строк...

Не мог бы ты пояснить, как именно нужно создавать процедуру и вешать ее на кнопку?

Твоя картинка смотрится изумительно - это именно то, что нужно... Да если еще это достигается в пару кликов, то это просто чудо... Мечта человека, анализирующего выгрузки из современных 1С с помощью Экселя...

ozioso
Надо
- приведенный код скопировать в тот же модуль, где и ф-ция;
- заменить в нем руками диапазон Range("B5:B34") на нужный;
- заменить максимальный уровень группировки iOut = 4 на нужный; если она встретит больший, то тупо встанет;
- заменить смещение по горизонтали iShf = 4, с которым она будет выводить данные, на нужное;
- сохраниться;
- убедившись, что курсор редактирования кода находится внутри процедуры, нажать F5.

Enjoy.

Повесить на кнопку можно, но, думаю, пока не надо. Все равно всплывут подводные камни, да и определение диапазона, введение необходимых проверок и защиты от дурака будет ужЕ отдельной трудоемкой задачей.

asbo
Спасибо ОГРОМНОЕ еще раз!

Однако, работает до 32 тысяч строк, а затем ошибка Overflow. Всего строк в таблице 304 тысячи. Я доделаю с помощью функции.

ozioso, на здоровье :)

Цитата:

работает до 32 тысяч строк

Замени декларацию:
Dim iTov% на
Dim iTov&
Только знак в знак. Копи-пасте.

Добавлено:
Внимание! Поправлено

Добавлено:
Я же говорил что всплывут подводные камни. Это первый :)
Дас ист моя вина - недоразмерил переменную на большой объем.

asbo
За код спасибо - буду разбираться,

Приветствую всех. Нужно заблокировать доступ к VBA коду рабочей книги. Я знаю, что в Exel есть возможность повесить пароль для доступа к коду. Но также я слыхал, что данное средство не очень надежное. Есть ли еще какие-либо способы организовать данный запрет, может есть возможность как-нибудь компильнуть) код, чтобы исключить возможность его просмотра впринципе?

KorolCOOL

Цитата:

... заблокировать доступ к VBA коду ... данное средство не очень надежное...способы организовать данный запрет ...как-нибудь компильнуть... исключить возможность его просмотра впринципе?

Оставь надежды всяк сюда входящий :)
Имо - не трать время. Неподъемно. Гугл в помощь по "VBA Защита кода", к примеру - давно и очень много разжевано под разными соусами и приправами. Недавно и здесь краешком задевали этот вопрос.

Есть ли вариант оптимизации данного кода?
Код: b3Row = False
b2Row = False
b1Row = False
' раскрываем третий уровень
For i = nRow To 1 Step -1
If Cells(i, 1).Interior.ColorIndex <> 15 And b3Row = False Then
Cells(i, 1).EntireRow.Hidden = False
Else
b3Row = True
Exit For
End If
Next i
' раскрываем второй уровень
For i = nRow To 1 Step -1
If b3Row Then
If Cells(i, 1).Interior.ColorIndex = 15 And b2Row = False Then
Cells(i, 1).EntireRow.Hidden = False
ElseIf Cells(i, 1).Interior.Color = 16751001 Then
b2Row = True
Exit For
End If
End If
Next i
' раскрываем первый уровень
For i = nRow To 1 Step -1
If b2Row Then
If Cells(i, 1).Interior.Color = 16751001 And b1Row = False Then
Cells(i, 1).EntireRow.Hidden = False
ElseIf Cells(i, 1).Interior.ColorIndex = 11 Then
b1Row = True
Exit For
End If
End If
Next i

Цитата:

Оставь надежды всяк сюда входящий
Имо - не трать время. Неподъемно. Гугл в помощь по "VBA Защита кода", к примеру - давно и очень много разжевано под разными соусами и приправами. Недавно и здесь краешком задевали этот вопрос.

Не поверите про Гугл даже и не вспонил. Дико извиняюсь.

Zloy_Gelud
Если именно по коду, в лоб, то
- заменил бы If на Select Case, поставив вперед то, что чаще встречается.
- Cells(i, 1).EntireRow == Rows(i)
- зачем доп. условие проверки b3Row = False [2,1], если оно уже по умолчанию False, а после первого же изменения его на True цикл прерывается и дальше оно не используется?

И я не понял из приведенного кода - а зачем в обратную сторону цикл?

KorolCOOL
Да ничего страшного. Просто тема обширна и в сети много информативных обсуждений есть. Я для себя ее закрыл с резюме - нельзя :)

Добавлено:
Zloy_Gelud
Не то зачеркнул. Д.б. так:

- зачем доп. условие проверки b3Row = False [2,1], если оно уже по умолчанию False, а после первого же изменения его на True цикл прерывается и дальше оно не используется?

И я не понял из приведенного кода - а зачем в обратную сторону цикл?

Проверки 'If b3Row Then' и 'If b2Row Then' вынести до цикла.

asbo

Цитата:

И я не понял из приведенного кода - а зачем в обратную сторону цикл?

Есть некий прайс-лист. Товары в нем разбиты на категории по уровням. Была задача написать свой собственный поиск товара по его коду, который раскрывал бы уровни, выделяя найденный товар. Поэтому приходится сначала отображать необходимые строки до этого товара, а затем после него, создавая иллюзию раскрытия необходимого уровня.

Zloy_Gelud
Я примерно так и понял, поэтому зачеркнул.

Как программно получить список всех свойств и методов объекта? Заколебывает жать точку, крутить список, и поштучно вставлять.

Объект - встраиваемый контрол OCX. Свойства Properties ни у него, ни у дочерних объктов нет.

asbo
Visual Basic: Inspect COM Components Using the TypeLib Information Object Library
RunTime COM Object Inspection вроде есть пример с исходником

smirnvlad
Спасибо. Мельком пробежался - вроде бы в тему. Буду разбираться.

asbo
может не "программно получить список всех свойств и методов объекта", а автоматизировать "жать точку, крутить список, и поштучно вставлять."