» Excel VBA

alin

Код:
Private Sub Workbook_Open()
On Error Resume Next ' - на случай, если лист не создан. А то будет ошибку выдавать
Sheets(Format(Now(), "dd.mm")).Activate
On Error Goto 0
End Sub

Troitsky
The okk
ДА! Именно то, что надо!
Низкий ВАМ поклон!

Как открыть картинку и чтобы через пару сек. она пропала (некое шоу)

Товарищи, подскажити плз.
Есть книга. в ней два листа.
При изменении ширины и высоты стобцов в первом листе, они точно так же меняются во втором.
Тоже самое с цветом заливки ячейки.
Так у меня не работает:

Sheets("Лист2").Range(Target.Address).Interior.ColorIndex = Target.Interior.ColorIndex
Sheets("Лист2").Range(Target.Address).Interior.Pattern = Target.Interior.Pattern

Тоже самое: если я нарисую таблицу в первом листе, то будет такая же таблица во втором.

А вобще мне надо при любом изменении в первом листе, делать такие же изменение во втором (т.е. один лист будет копией другого). Но в некоторых ячейках надо изменять все, кроме текста. До этого делал так: к первому листу привязывал скрипт:

Private Sub Worksheet_Change(ByVal Target As Range)

Sheets("Ëèñò2").Range(Target.Address).Value = Target.Value
Sheets("Ëèñò2").Range(Target.Address).Font.Size = Target.Font.Size
Sheets("Ëèñò2").Range(Target.Address).Font.Name = Target.Font.Name
Sheets("Ëèñò2").Range(Target.Address).Font.ColorIndex = Target.Font.ColorIndex
Sheets("Ëèñò2").Range(Target.Address).Font.Bold = Target.Font.Bold
Sheets("Ëèñò2").Range(Target.Address).Font.Underline = Target.Font.Underline
Sheets("Ëèñò2").Range(Target.Address).Font.Italic = Target.Font.Italic
Sheets("Ëèñò2").Range(Target.Address).Interior.ColorIndex = Target.Interior.ColorIndex
Sheets("Ëèñò2").Range(Target.Address).Interior.Pattern = Target.Interior.Pattern

End Sub

Может можно проще сделать?

там в скобках "Лист2"

Reznikoff
Насколько себе представляю ситуацию, при изменении формата ячейки (заливка, цвет шрифта и пр.) событие Worksheet_Change книги не возникает. Как такие изменения отловить я затрудняюсь сказать. Поэтому целесообразным считаю изменения во второй лист вносить только при его активации (ну или в случае особой надобности):
Код: Private Sub Worksheet_Activate()
Sheets(1).Cells.Copy
Sheets(2).Cells.PasteSpecial
Application.CutCopyMode = False
Sheets(2).Cells(1, 1).Select
End Sub

Цитата:

В таком случае во втором листе полностью будет повторяться первый, вплоть до скрытых строк, групп и структуры и т.д.

спасибо конечно, но многовато будет. Надо копировать все, но кроме определенных значений (т.е. будет все тоже, но без текста). как сделать?
далее делаю для второго листа:

Private Sub Worksheet_Activate()
Sheets("Лист2").Range("$A1:$HS644").Interior.ColorIndex = Sheets("Лист1").Range("$A1:$HS644").Interior.ColorIndex
Sheets("Лист2").Range("$A1:$HS644").Interior.Pattern = Sheets("Лист1").Range("$A1:$HS644").Interior.Pattern
End Sub

Изменяю цвет в ячейки в первом листе. включаю второй, а там ничего не меняется. а вроде по задумке должно.

Reznikoff

Цитата:

Надо копировать все, но кроме определенных значений

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

Вообще, общепринято получение (генерация) результата именно по окончании работы (или в случае действительной необходимости) - такой вариант наиболее "прозрачен" и ресурсоемок - получение промежуточных результатов на каждом шаге, как правило, приводит к лишней работе.


Добавлено:

Цитата:

Sheets("Лист2").Range("$A1:$HS644").Interior.ColorIndex = Sheets("Лист1").Range("$A1:$HS644").Interior.ColorIndex

В случае когда в диапазоне имеются ячейки с разными заливками всегда будет возвращаться белый цвет. В этом случае нужно использовать конструкцию вида:
Код: For Each mCell In Sheets("Лист2").Range("$A1:$HS644")
mCell.Interior.ColorIndex = Sheets("Лист1").Range(mCell.Address).Interior.ColorIndex
Next

Цитата:

но тормоза можно словить жуткие.

ловлю тормоза на домашнем компе. рабочий ноутбук тогда вобще сгорит.

Итак каким способом наиболее простым и без тормозов можно сделать задачку?
При этом известное фиксированное число ячеек. Т.е. одна таблица с одним и тем же числом полей и названиями. Но разные данные в таблице.

Reznikoff
Погоди. Так кроме форматов ничего больше из первого во второй лист копировать не надо? Т.е. текст вообще никакой не надо копировать? Тогда:
Код: Private Sub Worksheet_Activate()
Sheets(1).Cells.Copy
Sheets(2).Cells.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Sheets(2).Cells(1, 1).Select
End Sub

Цитата:

Так кроме форматов ничего больше из первого во второй лист копировать не надо?

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

Выходит что при активации воркшита скрипт изменяет ячейки (цвет, размер), а при изменении тектста ячейки в первом листе, они автоматом меняются во втором (по событию изменения листа, т.к. по этому событию нельзя отловить изменение цвета ячеек).

Troitsky

Цитата:

но тормоза можно словить жуткие.

А если попробовать уменьшить тормоза?:
Выключить обновление экрана (Application.ScreenUpdating = False)
Не использовать конструкцию For Each, а воспользоваться For Next.
Сократить диапазон до UsedRange.

А вообще, кто какие знает способы, как оптимизировать VBA (v 6.3) код по быстродействию?

The okk

Цитата:

А вообще, кто какие знает способы, как оптимизировать VBA (v 6.3) код по быстродействию?

Например, использование массивов может сильно ускорить занесение данных на лист Excel'я.
В качестве иллюстрации, сравни работу двух процедур (массив 1000x100 заносится в ячейки листа):
Код: Dim intArr(1 To 1000, 1 To 100) As Integer
Dim i As Integer: Dim j As Integer

Private Sub GenArr()
Randomize
For i = 1 To 1000
For j = 1 To 100
intArr(i, j) = Fix(Rnd + 0.5)
Next j
Next i
End Sub

Public Sub Variant1()
GenArr
Worksheets(1).Cells.Clear
For i = 1 To 1000
For j = 1 To 100
Worksheets(1).Cells(i, j).Value = intArr(i, j)
Next j
Next i
End Sub

Public Sub Variant2()
GenArr
Worksheets(1).Cells.Clear
Worksheets(1).Range(Cells(1, 1), Cells(1000, 100)).Value = intArr
End Sub

Troitsky
Спасибо. И впрямь должно работать быстрее (на 100 000 операций сложения).
А почему ты в качестве счетчиков используешь Integer - не в первый раз замечаю. У тебя 16-разрядная ОС?

Добавлено:
А свои кнопки в меню кто-нибудь создавал? Как тут значок кнопки (свой) сделать?

Добавлено:
И вот еще вопрос: если делаем цикл от 1 до UsedRange.Rows.Count, будет в каждом цикле опрашиваться это свойство?

The okk

Цитата:

если делаем цикл от 1 до UsedRange.Rows.Count, будет в каждом цикле опрашиваться это свойство?

Нет, только перед началом цикла. Проверял через пользовательскую функцию.

Yuk
Спасибо!

Добавлено:
А откуда данные брать быстрее - из переменных или из листа?

Инженер волнует, я плакал
Да ничего про Аксессе.

The okk

Цитата:

А почему ты в качестве счетчиков используешь Integer - не в первый раз замечаю. У тебя 16-разрядная ОС?

А при чем тут 16-разрядная ОС? Использование 16-разрядных целых (Integer) чисел просто требует меньше памяти для хранения, чем использование 32-разрядных длинных целых (Long) - два байта в первом случае против четырех во втором.
Да и если заранее известно, что число не выйдет из диапазона (-32 768;32 767), то зачем его хранить как длинное целое, если вполне можно хранить как целое?

Цитата:

А свои кнопки в меню кто-нибудь создавал? Как тут значок кнопки (свой) сделать?

По поводу кода добавления кнопки есть ссылка в шапке: Добавление в главное меню своего пункта, ассоциированного с макросом.
Для случая добавления кнопки на панель инструментов код будет отличаться не сильно.
Сами файлы (графические в формате *.bmp) кнопок должны выгладеть так:
собственно, сама пиктограмма -
и её маска -


Добавлено:
По поводу "выгладеть так", это в качестве примера подобным образом любую пиктограмму можно прикрутить

The okk

Конечно из переменных быстрее

Troitsky
Спасибо!
А где-нибудь есть таблица номеров стандартных значков (таблица с изображением значка и его номера)?

А про Integer и 16-разрядные - это я к тому, что 32-разрядные быстрее работают с типом Long. Я поэтому в качестве счетчика и использую этот тип... Ладно, не важно.

И как в Excel показывать/скрывать строки группы (кроме Excel4Macro("Show.Detail")).

Добавлено:
А. Вот. Нашел.

Добавлено:
Теперь бы еще найти таблицу всех значков.

Yuk
Счастье было не долгим

Теперь прошу помощи вновь по тому же поводу (http://forum.ru-board.com/topic.cgi?forum=5&topic=19106&start=1040), но теперь содержимое файликов может различаться. Т.е. - в разных файликах могут содержаться разные строки.
Но: у каждой строки есть свой уникальный идетификационный код который расположен в самом начале - в первом столбце, по ним и следует ориентироваться.

Уважаемый, Yuk, сделай милость - поведай как бы это безобразие изобразить.

Спасибо!

Так, со значками тоже разобрался - у Уокенбаха на сайте нашел надстройку.

Не так давно задавал вопрос попробую его уточнить и сам ответить!
С помощью каких действий можно установить такой способ защиты листа «от дурака», при котором ячейки недоступны пользователю, а элементы управления доступны?

В редакторе Visual Basiс удаляем значение свойства LinkedCell, затем на Панели Элементы управления нажимаем кнопку Исходный текст, и в редакторе Visual Basic формируется автоматически процедура обработки события ЭУ_Change:
Range(“…”).Value = ЭУ.Value
Защиту «от дурака» устанавливаем с помощью процедуры обработки события Workbook_Open():

ActiveSheet.Protect UserInterfaceOnly:=True

Вот ссылка на надстройку. - Наводишь на значок и тебе выводится его FaceId. Очень удобно. И рисовать ничего самому не пришлось - все нашел в стандартном наборе.
Это если кому-то тоже понадобится делать свою панель инструментов.

mrnovel
Выложи пару файлов для примера.

Какая из функций листа (читай - экселевских формул) может осуществлять поиск по неотсортированному массиву?

The okk
ПОИСКПОЗ для точного совпадения (последний аргумент 0).
Для неточного только сортировка.

Yuk
Спасибо!!

Yuk

Спасибо что откликнулся!

Вот в этом архиве: http://www.appetitnaya-strana.narod.ru/dds2.rar (размер архива 41 Кб, пароль на архив "934934" без кавычек) два файлика экселевских.

В одном из них некоторых строк не хватает.

В итоговой файлике - должны быть просуммированы значения в ячейках, при этом формулы не должны быть модифицированы; а недостающие строки добавлены.
В качестве идентификатора строки выступает код - он для каждой строки свой.

С твоего позволения позволю себе комментарий: это так называемая аналитическая таблица движения денежных средств - и два файлика которые надо будет просуммировать вот таким экзотическим образом это объединение информации по двум фирмам.

Спасибо ещё раз!

If Cells(i, 1) = "Итого" Then
если пиш утакое прокатывает
а если If Cells(i, 1) = "" Then вылезает ошибка 1004 как с этим боротся?