» Excel VBA (часть 2)

val_04
Спасибо огромное!

mike110 Действительно, со слиянием оказалость проще. только на полном списке еще не опробовал, т.к. не до конца набит еще. думаю проще будет в процессе набивания делать все это по частям. Спасибо большое за помощь!!!

SAS888

у меня та же ошибка. в вашем коде я изменил только "Лист" на "Sheet", далее в пустой книге сделал ссылку на ячейку в соседнем листе и пытаюсь кодом найти слово "Sheet" в формуле. получаю Subscript out of range.

ol7ca
Попробуйте из кода удалить строки
Код: On Error Resume Next

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

SAS888
я все сделал как вы писали - не помогло.
закоментировал If Error = 0 Then
и вставил MsgBox Sheets(i).Name & Chr(33) & myCell.Address
перед A(UBound(A)) = Sheets(i).Name & Chr(33) & myCell.Address
теперь вижу нужные сообщения.
спасибо!
а можно ли открывать лист и область с найденной ячейкой?

ol7ca
Можем вам вообще отказаться от обработчика ошибок и сделать код так, чтобы потом не гадать, где ляп? Или включать его только для одной строчки (если для какой-то операции без него никак), после неё сразу обработчик отключать... В вашем коде On Error вообще непонятно что делает. Вам действительно надо так лихо выполнять код? Ведь неизветно, в какой момент времени какой участок кода будет выполнен. Или вам нравится рулетка?

nick7inc
В коде для ol7ca перехват (простое игнорирование) ошибки включается перед строкой
Код: F = Sheets(i).Cells.SpecialCells(xlCellTypeFormulas).Count 'Поиск ячеек с формулами

Друзья,
подскажите где в Москве есть ПРОДВИНУТЫЕ курсы по VBA?
Ходил в specialist.ru но там всего 4 занятия.

SAS888

Цитата:

закоментировал If Error = 0 Then
и вставил MsgBox Sheets(i).Name & Chr(33) & myCell.Address
перед A(UBound(A)) = Sheets(i).Name & Chr(33) & myCell.Address
теперь вижу нужные сообщения.
Это "прокатит" только в том случае, если на листе присутствует хотя бы одна ячейка, содержащая формулу (я уже говорил об этом).

нет. все работает. я оставил On Error Resume Next и On Error GoTo 0


Цитата:

а можно ли открывать лист и область с найденной ячейкой?
Конечно можно. Но что делать дальше? Т.е. мы нашли первую интересующую нас ячейку, перешли по ссылке и остановились. А остальные?

в сообщении можно добавить кнопку "закончить поиск".

nick7inc
верно вы пишете, но я пытаюсь с этим разобраться:
On Error Resume Next - мне помогает в случае, когда нет формул на листе
а зачем If Error = 0 Then я так и не понял


Добавлено:
вставляю эту строку
Application.Calculation = xlCalculationAutomatic
почему-то не срабатывает
подскажите, пжлст, в чем ошибка

ol7ca

Цитата:

On Error Resume Next - мне помогает в случае, когда нет формул на листе

Мне кажется, что вы перемудрили. On Error покрывает у вас большую часть кода. Если вы без него никак не можете, то надо сделать так, чтобы он контролировал проблемный оператор, а за ним сразу его выключать. Смотрите фрагмент программы:

Код:
F=-1 ' Для проверки, что нет ячеек
On Error Resume Next 'Если нет ячеек с формулами - продолжать
F = Sheets(i).Cells.SpecialCells(xlCellTypeFormulas).Count 'Поиск ячеек с формулами
On Error goto 0 ' Выключаем обработчик
if F>0 then
' здесь идёт код, если есть ячейки
end if

nick7inc

Цитата:

Я тоже не совсем понимаю. Если хотите проверить, была ли ошибка, то это неверно по 2м причинам:
1) проверять надо Err.Number, а не Err
2) не совсем понятно, когда и какое значение будет иметь Err.Number внутри блока обработки ошибок. Я бы так не стал писать.

Это вовсе не для поиска ошибок (откуда им взяться?). Если на листе есть хотя бы одна ячейка с формулами, то Err = 0 и выполняется код сравнения и т.д., если Err <> 0, то переходим к следующему листу. Можно, конечно, сравнивать и
Цитата:

if F>0 then

, но какая разница?

SAS888

Цитата:

Это вовсе не для поиска ошибок (откуда им взяться?).

Да ну?! Шутите? Есть, причём как при работе оператора поиска, так, похоже, и в самом коде.

Цитата:

какая разница?

Я вам уже говорил: у вас при любой ошибке будет пропускаться строчка, вызвавшая ошибку, а т.к. охват On Error Resume Next у вас большой, то ваш код вообще непонятно как себя ведёт. Если вы такие крутые программисты, что же вы до сих пор не решили проблему?
Я вам указываю на проблемный участок программы, говорю, что он написан далеко не оптимально, сложен для понимания работы программы и её отладки.

[more=Последний раз советую...]Последний раз советую, контролируйте только Sheets(i).Cells.SpecialCells(xlCellTypeFormulas).Count. В вашем коде вы через Err не сможете реализовать проверку, контролируя только оператор поиска, поскольку объект Err обнуляется при выходе из блока обработки ошибки (например, после On Error Goto 0). Через переменную F с заданным значениме по-умолчанию -1, как мне кажется, оптимально. Если найдёте другой способ (только не тот, что вы сейчас отстаиваете), пишите, посмотрим.[/more]

По поводу Err коректнее писать Err.Number, поскольку это объект, а не числовая переменная. Почитайте помощь по VBA, там в примере написано:
Цитата:

If Err.Number <> 0 Then

Всем здравствуйте.
Программирование на VBA только начал изучать, поэтому прошу о помощи.
Дана таблица с m-множеством столбцов с данными и n-множеством строк с данными,
первая строка как обычно содержит заголовки столбцов.
Есть код:
a = Selection.AutoFilter(Field:=3, Criteria1:="условие")
который осуществляет фильтрацию столбца по "условию".
Вопрос: как программно получить количество отобранных записей
после применения фильтрации?
Заранее благодарен.

nick7inc
SAS888

я применил переменную F с заданным значениме по-умолчанию -1, но ошибка тут:
ReDim Preserve A(LBound(A) To UBound(A) - 1)
она там и была.
когда я убрал If Error = 0 Then - все заработало, но при условии что тут:"Sheet" нет ошбки, иначе опять ошибка тут:
ReDim Preserve A(LBound(A) To UBound(A) - 1)

Добавлено:
причем, код работает только когда On Error goto 0 стоит в конце, где и был
иначе - ошибка.
вот что у меня пока работает:
Dim i As Integer, F As Long, A() As String, myCell As Range
For i = 1 To ActiveWorkbook.Sheets.Count
On Error Resume Next
F = Sheets(i).Cells.SpecialCells(xlCellTypeFormulas).Count
'On Error GoTo 0 - ошибка.
If F > 0 Then
For Each myCell In Sheets(i).Cells.SpecialCells(xlCellTypeFormulas)
If InStr(1, myCell.Formula, "Sheet") <> 0 Then
MsgBox Sheets(i).Name & Chr(33) & myCell.Address
End If
Next
End If
On Error GoTo 0
Next
End Sub


при этом иногда код выдает похожие а не точные варинты
как при агументе True функции VLOOKUP
можно ли установить поиск точных значений или использовать другую функцию?

ol7ca

Цитата:

код работает только когда On Error goto 0 стоит в конце, где и был
иначе - ошибка

Это означает, что код не работает как надо. Он просто пропускает оператор Redim. А вообще, я не вижу оператора ReDim в вашем примере. Приведите весь код.

nick7inc

Цитата:

Это означает, что код не работает как надо.

А Вы сами пробовали хотя бы "протестить" предложенный код?
По проводу Вашего замечания на счет контроля ошибки я уже согласился. Только почему Вы предлагаете
Цитата:

F=-1

? Нужно F = 0.
На счет работы с массивом, действительно, если ни на одном листе книги нет ни одной ячейки с формулой, содержащей искомый фрагмент, то при выходе из всех циклов будет предпринята попытка уменьшить размерность массива из одного элемента (что есть ошибка).
Посмотрите следующий код, где устранен этот недостаток и учтены Ваши замечания.

Код: Sub qq()

Dim i As Integer, F As Long, A() As String, myCell As Range
ReDim A(0)
For i = 1 To ActiveWorkbook.Sheets.Count
F = 0
On Error Resume Next
F = Sheets(i).Cells.SpecialCells(xlCellTypeFormulas).Count
On Error GoTo 0
If F > 0 Then
For Each myCell In Sheets(i).Cells.SpecialCells(xlCellTypeFormulas)
If InStr(1, myCell.Formula, "Лист") <> 0 Then
A(UBound(A)) = Sheets(i).Name & Chr(33) & myCell.Address
ReDim Preserve A(LBound(A) To UBound(A) + 1)
End If
Next
End If
Next

If UBound(A) > 0 Then ' Если нет ни одной ячейки, то размерность уменьшать не будем
ReDim Preserve A(LBound(A) To UBound(A) - 1)

For i = LBound(A) To UBound(A)
MsgBox A(i)
Next
End If

End Sub

nick7inc
SAS888

Это весь код. Я оставил только то, что у меня работало. Я не понял зачем нужен массив, если все работает и так. Возможно, это повлечет другую ошибку, но пока я имею две проблемы:
1. иногда код мне дает ближайшее (не точное) значение, как правило тогда, когда там нет точного результата а есть похожий (А2 вместо А1).
2. На одном листе код "спотыкается" и дает ошибку

Но, все тоже самое происходит и с оригинальным кодом.
Вот мой вариант:Это весь код. Я оставил только то, что у меня работало. Я не понял зачем нужен массив, если все работает и так. Возможно, это повлечет другую ошибку, но пока я имею две проблемы:
1. иногда код мне дает ближайшее (не точное) значение, как правило тогда, когда там нет точного результата а есть похожий (А2 вместо А1).
2. На одном листе код "спотыкается" и дает ошибку

Но, все тоже самое происходит и с оригинальным кодом.
А может я чего-то перемудрил?
Вот мой вариант:
Sub A()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set wb = Application.Workbooks("map3.xls")
For ZZ = 2 To Workbooks("map3.xls").Sheets("TB").Range("K65536").End(xlUp).Row
If Not IsEmpty(ZZ) Then
CC = Cells(ZZ, 11)
qq MM, CC
Workbooks("map3.xls").Sheets("TB").Cells(ZZ, "L") = MM
End If
Next
End Sub
Sub qq(MM As Variant, CC As Variant)
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim i As Integer, F As Long, A() As String, myCell As Range
ReDim A(0)
For i = 1 To ActiveWorkbook.Sheets.Count
F = 0
On Error Resume Next
F = Sheets(i).Cells.SpecialCells(xlCellTypeFormulas).Count
On Error GoTo 0
If F > 0 Then
For Each myCell In Sheets(i).Cells.SpecialCells(xlCellTypeFormulas)
If InStr(1, myCell.Formula, CC) <> 0 Then
A(UBound(A)) = Sheets(i).Name & Chr(33) & myCell.Address
ReDim Preserve A(LBound(A) To UBound(A) + 1)
End If
Next
End If
Next

If UBound(A) > 0 Then
ReDim Preserve A(LBound(A) To UBound(A) - 1)
For i = LBound(A) To UBound(A)
MM = A(i)
'MsgBox A(i)

Next
End If

End Sub

SAS888

Цитата:

А Вы сами пробовали хотя бы "протестить" предложенный код?

Свой код я проверял. Чтобы ваш код проверить, мне нужен был последний полный вариант (не фрагмент). В предыдущем сообщении вы мне его предоставили, сейчас гляну.

Добавлено:

Цитата:

почему Вы предлагаете
Цитата:F=-1
? Нужно F = 0.

На тот случай, если (вдруг) функция вернёт 0 и мне потребуется определить, вернула она чего-нибудь или вылетела по ошибке. В последнем варианте (вряд ли она вернёт отрицательное значение) я получу -1.

Добавлено:

Цитата:

Хотя, опять же, нет никакой разницы, что проверять. Хоть "If F > 0", хоть If Err = 0 (но до восстановления обработчика ошибок). Согласны?

Вы имеете ввиду отмену програмной обработки ошибок при помощи On Error goto 0? Не согласен. Если вы используете конструкцию:
If условие Then
...
End If
и хотите использовать Err, то отмену програмной обработки ошибок вам придётся делать после блока IF ... Then ... End If, иначе вы обнулите Err. В этом случае, как я уже говорил, On Error Resume Next будет влиять на работу большого участка кода (что не оптимально, когда в коде есть недочёты). В своём примере я отменяю обработку ошибок сразу за "проблемным оператором". И если в моём коде есть ошибка, то она не маскируется оператором On Error Resume Next, а вылезает в процессе отладки с последующим её исправлением.

Добавлено:
SAS888
Код, похоже рабочий. Единственное, может быть ложное срабатывание при операциях со строками, содержащие формулы со словом "Лист".

Добавлено:
ol7ca

Цитата:

For ZZ = 2 To Workbooks("map3.xls").Sheets("TB").Range("K65536").End(xlUp).Row
If Not IsEmpty(ZZ) Then

Как я понял, ZZ - номер строки. Не думаю, что команда IsEmpty() даст правильный результат, ей нужно передать ссылку на одну ячейку, если вы хотите узнать, пустая ли ячейка. Со столбцами и строками дело сложнее...
Лучше применять конретные типы, а не универсальный variant. Отлаживать будет легче, да и код понятнее...

Цитата:

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Зачем без отмены действия, да ещё и несколько раз подряд вызывается?

Было бы легче вам помочь, если бы были коментарии к коду (что вы и где хотите сделать, что за параметры вы передаёте, что ожидаете получить), да и файлы примера, где у вас что-то работает, а где-то ошибка. Просто так код у меня не работает, а гадать что и как у вас я не хочу.

nick7inc

Цитата:

Как я понял, ZZ - номер строки. Не думаю, что команда IsEmpty() даст правильный результат, ей нужно передать ссылку на одну ячейку, если вы хотите узнать, пустая ли ячейка. Со столбцами и строками дело сложнее...

Для проверки строки на "пустоту" можно воспользоваться, например
Код: If Rows(ZZ).Text = "" Then MsgBox "Строка пуста"

вот пример файла с кодом о котором шла речь:
http://slil.ru/25662765
цель: в клонке А (лист TB) имя. Надо во всей книге найти где испольуется это имя (в формуле) и вставить ссылку в клонку B (лист TB). (желательно, чтобы по ссылке потом можно было перейти к указанной ячейке, а также при наличии 2-x и более ссылок - вписать их в ячейки справа)
основная проблема:
иногда код мне дает ближайшее (не точное) значение.
это видно в B50 (лист TB) - она верная а далее - ошибка до B99 и т.д.
почему так - я не могу понять.
и если хотя бы это исправить - то буду благодарен.
заранее спасибо за помощь.

ol7ca
Посмотрите Здесь. Сравните с Вашим кодом. Пояснений не вкладываю, т.к. все очевидно.

Подскажите пожалуйста как можно при запуске книги записать в реестр в определенную ветку значение (число), а при последующем запуске прибавлять единицу. Это нужно для того чтобы определить сколько раз использовалась данная книга. В справке прочитал что это обеспечивают функции: savesettings и getsetting.

Mint86
По Уокенбаху:

Код: Cnt = GetSetting("XYZ Corp", "InvoiceNum", "Count", 0)
Cnt = Cnt + 1
SaveSetting "XYZ Corp", "InvoiceNum", "Count", Cnt

SAS888

Цитата:

Для проверки строки на "пустоту" можно воспользоваться, например
Код:If Rows(ZZ).Text = "" Then MsgBox "Строка пуста"
, где ZZ - номер проверяемой строки.

У меня есть более универсальное средство:
Код: Public Function IsEmptyRange(Myrange As Range) As Boolean
Dim cell As Range
For Each cell In Myrange.Cells
If Not IsEmpty(cell) Then IsEmptyRange = False: Exit Function
Next cell
IsEmptyRange = True
End Function

Если такой ветки в реестре нет, то она будет создана.

Добавлено:
nick7inc
Полностью согласен, что это
Цитата:

более универсальное средство

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

SAS888

Цитата:

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

При условии, что он себя адекватно ведёт. К примеру, можно передать функции isEmpty() диапазон, содержащий несколько ячеек или даже столбец. Но функция ведёт себя неадекватно при данных условиях: она будет всегда возвращать одно и то же значение, в не зависимости от того, все ячейки пустые или нет.

Добавлено:
Предыдущее сообщение дополнил.

SAS888

Цитата:

Достали из реестра значение в переменную "Cnt" - увеличили на 1 и снова записали.

Спасибо! А можно этим или другим способом увеличивать значение в определенном ini или txt файле?

Mint86
Если имеется ввиду, что хранить какие-либо значения в .ini (.txt) файле, то нужно считывать и сохранять файл как текст. (Функция Workbooks.OpenText Filename:=...)

Добавлено:
nick7inc

Цитата:

К примеру, можно передать функции isEmpty() диапазон, содержащий несколько ячеек или даже столбец. Но функция ведёт себя неадекватно при данных условиях: она будет всегда возвращать одно и то же значение, в не зависимости от того, все ячейки пустые или нет.

Во истину так. Но это не относится к моему предложению
Код: If Rows(ZZ).Text = "" Then ...

Mint86

Цитата:

А можно этим или другим способом увеличивать значение в определенном ini или txt файле?

Читайте в справке: Open, Close, Print, Input