» Excel VBA (часть 2)

Denkxx
Это компилятор ошибается при выводе сообщения об ошибке. У Вас нет End If во второй конструкции. Либо вставьте, либо запишите в одну строку If... Then..., т.е. как в первом случае с If.

Добавлено:
MaximuS G
При присваивании ячейке формулы, например
Цитата:

ActiveCell.FormulaR1C1 = "=AVERAGE(R[-5] C:R[-1]C)"

Имеем обычную текстовую строку, с которой можно работать как с текстом. Например:

Код: ActiveCell.FormulaR1C1 = "=AVERAGE(R[" & x & "] C:R[-1]C)"

хелп ищу как обратиться к переменной range чтобы получить кол-во её строк???

vasiliy74
Например, так:

Код: Dim x As Range
Set x = Range("D5:F15")
MsgBox x.Rows.Count

SAS888
Спасибо Большое, но это не помогает если массив выбран как A:B...

Пишу функцию аналог VLOOKUP где в первом столбце есть несколько одинаковых значений а в возвращаемом столбце необходимо выбрать максимальное значение


Код: Public Function MAXVLOOKUP(valueIN, table_look As Range, numer_column As Integer)
Dim Index As Integer
Dim endcell As Integer
Index = 1
endcell = table_look.Rows.Count
While Index <= endcell
If table_look(Index, 1) = valueIN Then
If MAXVLOOKUP < table_look(Index, numer_column) Then
MAXVLOOKUP = table_look(Index, numer_column)
End If
End If
Index = Index + 1
Wend
End Function

vasiliy74

Цитата:

Спасибо Большое, но это не помогает если массив выбран как A:B...

Неправда ваша! работает! в Excel 2003 65536 строк. Вы же выбрали целиком два столбца.

похоже, что Вам нужно определить последнюю ИСПОЛЬЗОВАННУЮ ячейку в столбце..
это можно сделать так:

Прыгаем вверх до последней заполненной ячейки столбца COL:
lastrow = Cells(ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count,col).End(xlUp).Row

(col номер или имя столбца, например, для столбца A это будет
lastrow = Cells(ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count, "A").End(xlUp).Row

или так (самая последняя используемая строка в активной книге на активной листе:
>----------------------------------------------------------
Row1 = ActiveWorkbook.ActiveSheet.UsedRange.Row
Row2 = Row1 + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count
>----------------------------------------------------------

или так:
Cells.SpecialCells(xlLastCell).Row

Достаточно? Или ещё парочку вариантов подбросить? ;-)

SERGE_BLIZNUK
весомые аргументы .Rows.Count и правда работает только в первый раз при попытке почить значение строк вместо 65536 я получил 0 уж не знаю почему... а теперь всё ок..

SAS888
Угу, понял.
Но все-таки как организовать счетчик всех чекбоксов? или только вариант писать так, как приведено ниже для 50 чекбоксов? ))


Цитата:

Public vIbrano

Private Sub CheckBox1_Change()
vIbrano = vIbrano + 1
Label1.Caption = vIbrano
End Sub

Private Sub CheckBox2_change()
vIbrano = vIbrano +1
Label1.Caption = vIbrano
End Sub

Denkxx

Цитата:

как организовать счетчик всех чекбоксов?

Организовать-то можно. Но по какому событию запускать эту процедуру? При изменении значения определенного CheckBox-а возникает только его событие.
Конечно, повторять 50 раз код не нужно. Но вызов процедуры подсчета все равно придется вставлять.

SAS888
Спасибо большое ... по-поводу других что нибудь знаете ?...

Многоуважаемые! Как упростить код?
Дано: Sheet1 с фиксированными полями.туда заливаются ежедневные данные.
Есть Sheet "X". В нем колонки с датами.
В ШЫТ1 есть фиксированное поле с датой.
Задача: проверить дату в ШЫТ1 с датой в ШЫТ X и скопировать данные из множества непоследовательного выделения(фиксированное) ячеек из ШЫТ1 в другое мн-во непослед.ячеек на другом листе(ШЫТ Х).

И будет ли это все работать, если ШЫТ1 вынести в другую книгу?


Sub Macro1()
If Sheets("Sheet1").Range("B1").value = Sheets("Daily Loans Outs Actual").Range("B5").value Then
GoTo ActivateCopyPaste
ElseIf Sheets("Sheet1").Range("B1").value = Sheets("Daily Loans Outs Actual").Range("C5").value Then
GoTo ActivateCopyPaste2
Exit Sub
End If

ActivateCopyPaste:
Application.ScreenUpdating = False
Sheets("Sheet1").Select
Range("B6:B8").Copy
Sheets("Daily Loans Outs Actual").Select
Range("B40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B10:B12").Copy

Sheets("Daily Loans Outs Actual").Select
Range("B44").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B14:B16").Copy

Sheets("Daily Loans Outs Actual").Select
Range("B48").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B18:B20").Copy

Sheets("Daily Loans Outs Actual").Select
Range("B56").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B22:B24").Copy

Sheets("Daily Loans Outs Actual").Select
Range("B60").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Exit Sub
ActivateCopyPaste2:
Application.ScreenUpdating = False
Sheets("Sheet1").Select
Range("B6:B8").Copy
Sheets("Daily Loans Outs Actual").Select
Range("C40").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B10:B12").Copy

Sheets("Daily Loans Outs Actual").Select
Range("C44").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B14:B16").Copy

Sheets("Daily Loans Outs Actual").Select
Range("C48").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B18:B20").Copy

Sheets("Daily Loans Outs Actual").Select
Range("C56").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Range("B22:B24").Copy

Sheets("Daily Loans Outs Actual").Select
Range("C60").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

MaximuS G
Убрать, например, из активной ячейки сообщение об ошибке, заменив значение на ноль, можно так:

Код: If IsError(ActiveCell.Value) Then ActiveCell = 0

SAS888
ясно. в общем сделал просто мессаджбоксом. Спасибо всем за помошь. Наконец закончил макрос полностью.

SAS888
Для тупых...можно расшифровать.
case [b5]:j=2 что это значит? и почему равно 2?
case else - это дополнительные условия?
ПОлучается что там наверно должна быть дата. А это значит что будет 28-31 таких case?

Какой алгоритм оператора For...next в данном случае.

Спасибо.

Не прошло и полу часа. Опять возник вопрос.
Пишу простенький макрос. Который копирует выделенную область и вставляет в свободную строку другого файла Exel. Вроде бы все просто, но не работет.

Код:
Sub Макрос5()

Selection.Copy

SAS888
Спасибо!


Denkxx

Dim wbName As String
Dim wb As Workbook

wbName = "Книга Продаж_2008_09_10.xls"

For Each wb In Workbooks
If wb.Name = wbName Then
Exit For
Else
Workbooks.Open FileName:= _
"C:\..."
End If
Next wb

А последнюю строку можно искать не через цикл... 122 стр ну и там в районе еще есть кое-что...

ВОПРОС

Как на VBA в форме, где есть textbox сделать контекстное меню (копировать вырезать вставить)? Сочетания клавиш Ctrl+X +C +V работают, но хочется большего.

Добавлено:
Вопрос
Есть textbox для заполнения. Пояснение label над ним. Места на форме уже не хватает.
Хочу сделать чтобы пояснение было в самом textbox (не подсказка)
textbox="введите цифру"
if textbox="" then textbox="введите цифру"
Как это реализовать? Можно еще и шрифт сереньким сделать пока данные не введены.

Denkxx
MaximuS G
Открыть книгу, если не открыта, или активировать, если уже открыта, проще так:

Код: Dim x As Workbook
On Error Resume Next
Set x = Workbooks.Open("C:\Temp\Книга Продаж_2008_09_10.xls")
On Error GoTo 0

SAS888
СУПЕР!!! чрезвычайно благодарен.Оказывается все так просто. Но сам бы до этого вряд ли дошел...Гуманитарий я ))
А вот еще вопросик по поводу case...у меня вот получается 31 колонка. А можно все эти j как-то диапазоном прописать вместе с присвоенным номером колонок?
Ну и еще один... раз уж такая пьянка пошла

Какой код нужен, чтоб вставить новый лист с таким же форматированием, формулами, короче ВСЕМ, НО БЕЗ values и чтоб можно было выбрать из списка месяц и в этом новом листе было бы добавлено кол-во колонок, соответствующее кол-ву календарных дней в этом месяце. Ну и чтоб даты вставились автоматически. и чтоб название листа было "mm-yy"

Спасибо.

SAS888

Код: Dim x As Workbook
On Error Resume Next
Set x = Workbooks.Open("C:\Temp\Книга Продаж_2008_09_10.xls")
On Error GoTo 0

SAS888
Ну вот...я продлеваю диапазон copy\paste по приведенному выше алгоритму, но он не все данные вставляются. грубо говоря, во второй итерации не добавляются по последней строке всех диапазонов, а в третей итерации вообще только одно какое-то значение вставляется...что я не так делаю?

Добавлено:
SAS888
Разобрался.По поводу последнеего поста

Denkxx
Не знаю, у меня все работает ... А что говорит ?

MaximuS G
При закрытом файле Книга Продаж_2008_09_10.xls. Все работает нормально. Т.е. он запускается и выделенное вставляется в нужную ячейку. Но если файл Книга Продаж_2008_09_10.xls уже открыт, то вылезает сообщение "Файл "Книга Продаж_2008_09_10.xls" уже открыт. Повторное открытие приведет к потере выполненных изменений. Открыть файл "Книга Продаж_2008_09_10.xls"?"
Если да, то Run-time error '1004': Метод Paste из класса Worksheet завершен не верно.
Если нет, то Run-time error '1004': Method 'Open' of object 'Workbooks' failed.

Denkxx
А если так ?

On Error Resume Next
If Application.Workbooks("книга1.xls") Is Nothing Then
Workbooks.Open ("C:\Documents and Settings\...")
Else
MsgBox ("Книга уже открыта")
End If

MaximuS G
С этим понятно, а как ее тогда активировать для дальнейшей вставки инфы?


Добавлено:
Разобрался. Добавил в Elase
Windows("Книга Продаж_2008_09_10.xls").Activate
                                                                                                                                                                                                                                    

Denkxx
Так работает ?

Возникла еще одна ситуация. Можно ли как-то сделать проверку используется в данный момент файл Книга Продаж_2008_09_10.xls или нет. Если используется то выдать сообщение и не запускать его? Просто если этот файл открыт у одного лользователя, а другой запускает у себя этот макрос, то книга по умолчанию открывается в режиме только чтения и сохранить изменения потом нельзя. А если в ручную запускать этот файл, во вылетает сообщение, что файл уже используется и варианты действий "Открыть только для чтения." и "отмена."

Добавлено:

Цитата:

Denkxx
Так работает ?

да. сделал так.

Код:
On Error Resume Next
If Application.Workbooks("книга1.xls") Is Nothing Then
Workbooks.Open ("C:\Documents and Settings\...")
Else
Windows("книга1.xls").Activate
End If

SAS888
Спасибо!!!
Работает, но не совсем корректно. Если использовать мышку, то textbox работает корректно, а вот если использовать Tab то не работает.

Задача: изменить формат даты на текстовый, предварительно скопировав дату удалить, изменить формат и вставить

Sub format()
'
Range("C4").Select
Selection.ClearContents
Selection.NumberFormat = "@"
ActiveSheet.Paste
End Sub

Что-то не выходит, хотелось бы применить все к диапазону

Перехват события "окно вывода сообщения об ошибке" и ...
1) отображение на этой форме своего сообщения, либо
2) запуск по этому событию своего макроса

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

Спасибо in advance!

Denkxx

Цитата:

С этим кодом он открывает файл и копирует данные как надо. Но при открытом файле от опять пишет, что файл открыт и повторное открытие приведет к потере данных. Нажимаем Да - получаем ошибку, Нет - задание не выполнено.
как же он активирует уже открытый файл?

Позвольте усомниться в Вашем высказывании.
Во-первых, проверено. Код рабочий.
Во-вторых, если Вы обратили внимание, то самая первая строка кода
Код: On Error Resume Next