Помогите пожалуйста "исправить" макрос для поиска среди имен листов по части названия. А то я понакручивал себе уже ... По этому куску кода ищет совпадения, но при выборе "Да" - не останавливается. И соответственно ничего не пишет, если совпадений не было найдено. [vba]
Код
Sub Macros() Dim ws As String Dim a As Integer
ws = InputBox("ВВедите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name)
If ws = "" Then Exit Sub On Error Resume Next
For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select choice = MsgBox("Нашли?", vbYesNo) If choice = "Yes" Then Exit For ' Exit inner loop. End If Next i If Err Then MsgBox "Листа с таким именем нет" End Sub
[/vba]
Помогите пожалуйста "исправить" макрос для поиска среди имен листов по части названия. А то я понакручивал себе уже ... По этому куску кода ищет совпадения, но при выборе "Да" - не останавливается. И соответственно ничего не пишет, если совпадений не было найдено. [vba]
Код
Sub Macros() Dim ws As String Dim a As Integer
ws = InputBox("ВВедите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name)
If ws = "" Then Exit Sub On Error Resume Next
For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select choice = MsgBox("Нашли?", vbYesNo) If choice = "Yes" Then Exit For ' Exit inner loop. End If Next i If Err Then MsgBox "Листа с таким именем нет" End Sub
Из-за того, что у Вас VBE пометил красным - фигню какую-то, написанную в MsgBox: [vba]
Код
choice = MsgBox("I'a`?e"e`?", vbYesNo)
[/vba] и не правильно отлавливаете его ответ Ну и ещё может быть, если у Вас в декларациях прописано Option Explicit, то из-за того, что вместо переменной i определили а[vba]
Код
Sub Macros() Dim ws As String Dim i As Integer ws = InputBox("Введите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name) If ws = "" Then Exit Sub On Error Resume Next For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select If MsgBox("Этот лист?", vbYesNo) = vbYes Then Exit For ' Exit inner loop. End If Next i If Err Then MsgBox "Листа с таким именем нет" End Sub
[/vba]
Из-за того, что у Вас VBE пометил красным - фигню какую-то, написанную в MsgBox: [vba]
Код
choice = MsgBox("I'a`?e"e`?", vbYesNo)
[/vba] и не правильно отлавливаете его ответ Ну и ещё может быть, если у Вас в декларациях прописано Option Explicit, то из-за того, что вместо переменной i определили а[vba]
Код
Sub Macros() Dim ws As String Dim i As Integer ws = InputBox("Введите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name) If ws = "" Then Exit Sub On Error Resume Next For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select If MsgBox("Этот лист?", vbYesNo) = vbYes Then Exit For ' Exit inner loop. End If Next i If Err Then MsgBox "Листа с таким именем нет" End Sub
VBE пометил красным - фигню какую-то, написанную в MsgBox
Леш, там на самом деле все нормально написано. Просто когда копировались данные из окна VBA - язык стоял английский, а когда сюда вставлялись - язык стоял русский. Поэтому русские буквы и поменялись. помнишь, тут даже тема про это была?
VBE пометил красным - фигню какую-то, написанную в MsgBox
Леш, там на самом деле все нормально написано. Просто когда копировались данные из окна VBA - язык стоял английский, а когда сюда вставлялись - язык стоял русский. Поэтому русские буквы и поменялись. помнишь, тут даже тема про это была?_Boroda_
Саш, а ты не обратил внимание, что не все русские буквы "скракозяьрились". Значит, с раскладкой было всё в порядке. А вот если попытаться вставить в VBE текст процедуры из первого поста, то там появляется лишняя не закрытая кавычка среди зюковок.
Саш, а ты не обратил внимание, что не все русские буквы "скракозяьрились". Значит, с раскладкой было всё в порядке. А вот если попытаться вставить в VBE текст процедуры из первого поста, то там появляется лишняя не закрытая кавычка среди зюковок.Alex_ST
Блин! Есть свободное время и желание посмотреть, что так понравилось DJ_Marker_MC, а разрешения на загрузку файлов с макросами на работе нет... (Сволочи сисадмины!) А пока до дому доберусь, забуду Там только процедуры или ещё и форма? Если только текст, то кто-нибудь скиньте его сюда, пожалуйста, повеселите старика (до совещания ещё 45 минут, а делать нечего).
Блин! Есть свободное время и желание посмотреть, что так понравилось DJ_Marker_MC, а разрешения на загрузку файлов с макросами на работе нет... (Сволочи сисадмины!) А пока до дому доберусь, забуду Там только процедуры или ещё и форма? Если только текст, то кто-нибудь скиньте его сюда, пожалуйста, повеселите старика (до совещания ещё 45 минут, а делать нечего).Alex_ST
Кстати, тест àáâãäå¸æçèêëìíóôõ éöóêåíãøùçõúýæäëîðïàâûôÿ÷ñìèòüáþ.
при вводе в VBE греческая каппа воспринимается как кавычка. А "раскракозябрить" скриптом удалось.: абвгдеёжзиклмнуфх йцукенгшщзхъэждлорпавыфячсмитьбю.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Четверг, 05.06.2014, 15:09
Private Sub ListBox1_Click() Sheets(ListBox1.Text).Activate End Sub
Private Sub TextBox1_Change() Dim sh As Worksheet ListBox1.Clear For Each sh In ThisWorkbook.Worksheets If Not TextBox1.Text = "" Then If LCase(sh.Name) Like "*" & LCase(TextBox1.Text) & "*" Then ListBox1.AddItem sh.Name End If End If Next End Sub
[/vba] Ничего сверхестественного
Форма\текстбокс\листбокс код: [vba]
Код
Private Sub ListBox1_Click() Sheets(ListBox1.Text).Activate End Sub
Private Sub TextBox1_Change() Dim sh As Worksheet ListBox1.Clear For Each sh In ThisWorkbook.Worksheets If Not TextBox1.Text = "" Then If LCase(sh.Name) Like "*" & LCase(TextBox1.Text) & "*" Then ListBox1.AddItem sh.Name End If End If Next End Sub
Спасибо. Просто и эффективно. Даже в голову не приходило так сделать. Просто у меня в рабочих книгах больше десятка листов не бывает, вот и не нужно было. А у девочек в соседней комнате кабельные журналы листов по 50. Они, наверное, оценят.
Спасибо. Просто и эффективно. Даже в голову не приходило так сделать. Просто у меня в рабочих книгах больше десятка листов не бывает, вот и не нужно было. А у девочек в соседней комнате кабельные журналы листов по 50. Они, наверное, оценят.Alex_ST
Karbofox, вместо ошибки проверяйте переключатель: [vba]
Код
Sub Macros() Dim ws As String Dim a As Integer Dim boo As Boolean ' добавим переключатель
ws = InputBox("Введите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name)
If ws = "" Then Exit Sub On Error Resume Next boo = False For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select choice = MsgBox("Нашли?", vbYesNo) If choice = vbYes Then Exit For boo = True 'если вошли в условие, то переключатель в ТРУ End If Next 'если переключатель остался в ФОЛС, то даем меседж. If boo = False Then MsgBox "Листа с таким именем нет" End Sub
[/vba]
Karbofox, вместо ошибки проверяйте переключатель: [vba]
Код
Sub Macros() Dim ws As String Dim a As Integer Dim boo As Boolean ' добавим переключатель
ws = InputBox("Введите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name)
If ws = "" Then Exit Sub On Error Resume Next boo = False For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select choice = MsgBox("Нашли?", vbYesNo) If choice = vbYes Then Exit For boo = True 'если вошли в условие, то переключатель в ТРУ End If Next 'если переключатель остался в ФОЛС, то даем меседж. If boo = False Then MsgBox "Листа с таким именем нет" End Sub
Потому, что Вы выходите из цикла, но не из макроса. Нужно что-то типа If choice = 6 Then Exit Sub И, как уже заметили выше, ошибки-то не возникает [vba]
Код
Sub Macros() Dim ws As String Dim a As Integer
ws = InputBox("ВВедите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name)
If ws = "" Then Exit Sub On Error Resume Next
For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select choice = MsgBox("он?", vbYesNo) If choice = 6 Then Exit Sub ' Exit inner loop. End If Next i MsgBox "Листа с таким именем нет" End Sub
Потому, что Вы выходите из цикла, но не из макроса. Нужно что-то типа If choice = 6 Then Exit Sub И, как уже заметили выше, ошибки-то не возникает [vba]
Код
Sub Macros() Dim ws As String Dim a As Integer
ws = InputBox("ВВедите имя листа/часть имени", "Поиск листа по имени", ActiveSheet.Name)
If ws = "" Then Exit Sub On Error Resume Next
For i = 1 To Worksheets.Count If InStr(Worksheets(i).Name, ws) > 0 Then Worksheets(i).Select choice = MsgBox("он?", vbYesNo) If choice = 6 Then Exit Sub ' Exit inner loop. End If Next i MsgBox "Листа с таким именем нет" End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
По этому куску кода ищет совпадения, но при выборе "Да" - не останавливается. И соответственно ничего не пишет, если совпадений не было найдено. 
