Vba excel поиск по textbox

я уже такое пробовал ) вот ошибка

И ещё будет 10 страниц переписки, пока будешь думать, что задаёшь вопросы на форуме по фотошопу или на форуме экстрасенсов!!!
Не получается — приложи файл! уже б и забыл про вопрос!

Выдает ошибку (см. скрин) ) если попытаться очистить ListBox то будет выдавать ошибку

ЗАЧЕМ чистить листбокс???
И ошибку не выдаёт! Можешь верить, можешь не верить. Но второй раз набивать таблицу, что бы тебе что-то доказать мне лениво!

Добавлено через 9 минут
и убери эту строку!

Visual Basic
1
  .RowSource = "A2:F100"

в моём случае она не нужна 100%
А если хочешь всё-таки искать в списке, то заполняй список значениями, а не ссылкой на источник

Добавлено через 24 минуты
1. при вводе в верхнее поле в список попадают все ячейки с их значениями и адресами.
2. при выборе значения в списке ячейка в диапазоне выделяется а в нижнее поле выводится строка
3. при пустом верхнем поле список и нижнее поле скрываются
4. список не надо не редактировать не очищать!

 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

#1

14.04.2017 00:36:21

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

Вот код TextBoxа который ищет в массиве по столбику с названием принтера и картриджа ( например ML-2525 MLT-D105S*)
Да этот поиск работает, но только если вводить фразу сначала. Частичный поиск (например ввести 2525) ничего не выдает.

Как допилить его чтобы выводил все частично совпадающие результаты?

Код
Private Sub tbName_Change()
Dim LastRow As Long, i As Long, x As Long, Arr()
    Me.ListBox1.Clear
    With Sheets("лист3")
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Arr = .Range(.Cells(2, 1), .Cells(LastRow, 5)).Value
    End With
    With ListBox1
        For i = 1 To UBound(Arr)
            If UCase(Arr(i, 2)) Like UCase(Me.tbName) & "*" Then
                .AddItem ""
                .List(x, 0) = i + 1
                .List(x, 1) = Arr(i, 1)
                .List(x, 2) = Arr(i, 2)
                .List(x, 3) = Arr(i, 3)
                .List(x, 4) = Arr(i, 4)
                .List(x, 5) = Arr(i, 5)
                
                x = x + 1
 
            End If
        Next
   End With
End Sub

Прикрепленные файлы

  • Прайс_Новый поиск.xlsm (75.7 КБ)

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

#2

14.04.2017 00:49:06

Попробуйте так:

Код
If UCase(Arr(i, 2)) Like "*" & UCase(Me.tbName) & "*" Then


 

VideoAlex

Пользователь

Сообщений: 656
Регистрация: 01.01.1970

#3

14.04.2017 00:50:02

В 10-й строчке

Код
If UCase(Arr(i, 2)) Like "*" & UCase(Me.tbName) & "*" Then

Изменено: VideoAlex14.04.2017 00:51:21

 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

Да спасибо =) не понимал как эту строчку по синтаксису расписать правильно =)

 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

А с помощью чего можно вывести (сохранить) значения из листбокс2 в пдф или ворд файл по определенному формату? как таблицу например =)

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

А какое отношение этот вопрос имеет к заявленной теме?

 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

Согласен никакого =( не хотел темы плодить =(

 

V

Пользователь

Сообщений: 5018
Регистрация: 22.12.2012

kyzavrik, не забудьте на Кибере отписаться. и на остальных форумах если создавали тему с этим вопросом.

 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

#9

14.04.2017 11:55:26

Цитата
V написал:
Кибере отписаться

Да, там в это же время уже описались =) так что ответы есть в обоих темах =)

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

#10

14.04.2017 12:58:03

Цитата
kyzavrik написал:
там в это же время уже описались

Всё так плохо? ))

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

kyzavrik, размещаете вопрос на нескольких форумах — информируйте об этом.

 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

#12

21.04.2017 12:34:53

А можно в строке поиска чтобы поиск был по 2 стобцам сразу? Допустим чтобы не делать столбик название_принтера+картридж, а просто столбец А и Б (в нашем случае (arr(i, 2)) и (arr(i, 3)) )
Это будет выглядеть так? или в рамках одного ифа это не реализуется?

Код
If UCase(arr(i, 2)) or UCase(arr(i, 3)) Like "*" & UCase(Me.tbName) & "*" Then
 

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

#13

21.04.2017 12:39:17

Цитата
Юрий М написал: размещаете вопрос на нескольких форумах — информируйте об этом.

Вы же не хотите, чтобы помогающие тратили время на решения, которые уже есть на другом форуме?

 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

vikttur, данного решения нет на другом форуме где я спрашивал изначально.
Кросс-темой данной является

вот эта на киберфоруме

Изменено: kyzavrik21.04.2017 12:52:01

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

#15

21.04.2017 13:05:43

Цитата
kyzavrik написал:
или в рамках одного ифа это не реализуется?

Реализуется: проверяйте оба элемента массива. В общем случае это будет выглядеть так:

Код
If arr(i, 2) = xxx Or arr(i, 3) = xxx Then
 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

#16

21.04.2017 13:14:52

Юрий М, понял спасибо. Значит вот так:

Код
If (arr(i, 2) Like "*" & UCase(Me.tbName) & "*") Or (arr(i, 3) Like "*" & UCase(Me.tbName) & "*") Then
 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

Почему написанная выше строчка не реагирует на совпадение вначале словаесли я ищу в столбике допустим Canon FX-10
Вбиваю canon  0 результатов
Вбиваю canon fx-10  0 результатов
вбиваю fx-10 он выдает все совпадения по fx-10

Но если название состоит из одного слова, допустим q7516a. То он его находит без проблем.
То есть какая-то проблема с данными состоящими из 2 и более слов.

Изменено: kyzavrik21.04.2017 21:56:51

 

RAN

Пользователь

Сообщений: 7091
Регистрация: 21.12.2012

#18

21.04.2017 22:06:55

Цитата
kyzavrik написал:
Значит вот так:

Значит не так

Код
           If (LCase(arr(i, 1)) Like "*" & LCase(Me.tbName) & "*") Or (LCase(arr(i, 4)) Like "*" & LCase(Me.tbName) & "*") Or (LCase(arr(i, 4)) Like LCase(Me.tbName) & "*") Then
 

kyzavrik

Пользователь

Сообщений: 53
Регистрация: 13.04.2017

RAN,ой спасибо. LCase как я понял это чтобы он видел целую строку, а не последнее слово?

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

UCase — в верхний регистр (прописные), LCase — в нижний (строчные). «Целая строка» тут причём?

 

RAN

Пользователь

Сообщений: 7091
Регистрация: 21.12.2012

#21

21.04.2017 22:20:25

Справку почитать совсем никак?
ГЫ В #12 почти правильная строка.
Возьми почти правильную строку, убери из неё существующие ошибки, и добавь новые…  :D

Изменено: RAN21.04.2017 22:31:56

Please Note:
This article is written for users of the following Microsoft Excel versions: 97, 2000, 2002, and 2003. If you are using a later version (Excel 2007 or later), this tip may not work for you. For a version of this tip written specifically for later versions of Excel, click here: Finding Text in Text Boxes.

Written by Allen Wyatt (last updated October 12, 2021)
This tip applies to Excel 97, 2000, 2002, and 2003


Walter has a worksheet that has a number of text boxes in it. He would like to search through those text boxes to find some specific text, but Find and Replace doesn’t seem capable of finding text in text boxes. He wonders if there is a way to search through text boxes.

Walter is right; you cannot find text located in text boxes in Excel. To test this, we opened a brand new workbook, placed a single phrase in it («my message»), and then placed some random text and numbers in other cells in the worksheet. Then, with the text box not selected, Ctrl+F was pressed to search for «my message.» Excel dutifully reported that it couldn’t find the text, even though it was still right there, in the text box.

Fortunately, you can search for text in a text box using a macro. Each text box in a worksheet belongs to the Shapes collection, so all you need to do is step through each member of the collection and see if it contains the desired text. Here’s a macro that prompts for a search string and then looks for it in the text boxes.

Sub FindInShape1()
    Dim rStart As Range
    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    Set rStart = ActiveCell
    For Each shp In ActiveSheet.Shapes
        sTemp = shp.TextFrame.Characters.Text
        If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then
            shp.Select
            Response = MsgBox( _
              prompt:=shp.Name & vbCrLf & _
              sTemp & vbCrLf & vbCrLf & _
              "Do you want to continue?", _
              Buttons:=vbYesNo, Title:="Continue?")
            If Response <> vbYes Then
                Set rStart = Nothing
                Exit Sub
            End If
        End If
    Next
    MsgBox "No more found"
    rStart.Select
    Set rStart = Nothing
End Sub

This macro looks through all the shapes in the worksheet, not just the text boxes. If you prefer to limit your search to only text boxes, you can step through the TextBoxes collection instead of the Shapes collection; either way will work fine.

Notice, as well, that this approach stops each time it finds matching text (the case of the text doesn’t matter) and asks you if you want to continue. You may, instead, want a macro that simply marks the matching text in text boxes. This can be done with a shorter macro, as shown here:

Sub FindInShape2()
    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim iPos As Integer
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    sFind = LCase(sFind)
    For Each shp In ActiveSheet.Shapes
        sTemp = LCase(shp.TextFrame.Characters.Text)
        iPos = InStr(sTemp, sFind)
        If iPos > 0 Then
            With shp.TextFrame.Characters(Start:=iPos, _
              Length:=Len(sFind)).Font
                .ColorIndex = 3
                .Bold = True
            End With
        End If
    Next
    MsgBox "Finished"
End Sub

This macro highlights the located text using a bold, red font. When you are done, you probably want to change the text back to regular text. You can do so by using the following macro:

Sub ResetFont()
    Dim shp As Shape

    For Each shp In ActiveSheet.Shapes
        With shp.TextFrame.Characters.Font
            .ColorIndex = 0
            .Bold = False
        End With
    Next
End Sub

If you would like to know how to use the macros described on this page (or on any other page on the ExcelTips sites), I’ve prepared a special page that includes helpful information. Click here to open that special page in a new browser tab.

ExcelTips is your source for cost-effective Microsoft Excel training.
This tip (11281) applies to Microsoft Excel 97, 2000, 2002, and 2003. You can find a version of this tip for the ribbon interface of Excel (Excel 2007 and later) here: Finding Text in Text Boxes.

Author Bio

With more than 50 non-fiction books and numerous magazine articles to his credit, Allen Wyatt is an internationally recognized author. He is president of Sharon Parq Associates, a computer and publishing services company. Learn more about Allen…

MORE FROM ALLEN

Calculating an IRR with Varying Interest Rates

You might wonder how you can calculate an IRR (internal rate of return) when the person repaying the loan pays different …

Discover More

Working with Form Fields

You know you want to use form fields in your document (they are essential in creating forms, after all) but you need to …

Discover More

Foul Water Odor

Got a foul odor coming from your water tap? It could be caused by a number of different issues, as discussed in this tip.

Discover More

форма поиска через textbox

Лехаа

Дата: Понедельник, 01.04.2013, 15:13 |
Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 68


Репутация:

4

±

Замечаний:
0% ±


сложно ли слелать замену стандартному поиску который вызывается через ctrl+f ?
думал поможет макрорекордер, но нет sad не получилось
задачка проста: в столбце E:E найти и перейти на строку где содержится искомое вводимое в textbox
прошу помощи т.к. сам еще слабоват в написании своих макросов

 

Ответить

Serge_007

Дата: Понедельник, 01.04.2013, 15:44 |
Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 15894


Репутация:

2623

±

Замечаний:
±


Excel 2016

См. вложение

К сообщению приложен файл:

Lehaa.xls
(40.5 Kb)


ЮMoney:41001419691823 | WMR:126292472390

 

Ответить

Лехаа

Дата: Понедельник, 01.04.2013, 16:01 |
Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 68


Репутация:

4

±

Замечаний:
0% ±


Большое спасибо! работает biggrin

 

Ответить

Serge_007

Дата: Понедельник, 01.04.2013, 16:10 |
Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 15894


Репутация:

2623

±

Замечаний:
±


Excel 2016

Добавьте ещё проверку на ошибку и на пустой текстбокс:
[vba]

Код

Private Sub CommandButton1_Click()
Dim q As String
   q = TextBox1.Value
   If q = «» Then MsgBox («Чего искать-то?»)
    On Error GoTo ErrorHandler
Columns(«E:E»).Find(What:=q, LookIn:=xlValues, LookAt:=xlWhole).Activate
    Exit Sub
ErrorHandler:
    MsgBox («Нету такого!»)
Resume Next
End Sub

[/vba]


ЮMoney:41001419691823 | WMR:126292472390

 

Ответить

Лехаа

Дата: Понедельник, 01.04.2013, 16:16 |
Сообщение № 5

Группа: Пользователи

Ранг: Участник

Сообщений: 68


Репутация:

4

±

Замечаний:
0% ±


упс… cry недоглядел, если значение не ввести полностью то вываливается с ошибкой, можно сделать чтобы по первому совпадению находило и продалжало искать дальше если кнопку поиск нажимать?

 

Ответить

Serge_007

Дата: Понедельник, 01.04.2013, 16:17 |
Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 15894


Репутация:

2623

±

Замечаний:
±


Excel 2016

Цитата (Лехаа)

если значение не ввести полностью то вываливается с ошибкой

xlWhole замените на xlPart


ЮMoney:41001419691823 | WMR:126292472390

 

Ответить

Лехаа

Дата: Понедельник, 01.04.2013, 16:30 |
Сообщение № 7

Группа: Пользователи

Ранг: Участник

Сообщений: 68


Репутация:

4

±

Замечаний:
0% ±


Цитата (Serge_007)

Добавьте ещё проверку на ошибку и на пустой текстбокс:

вот это поставил smile хорошо работает и не вываливается теперь, но не ищет дальше, там может быть еще совпадение apple , хорошо бы показывал на форме сколько совпадений нашлось wacko

 

Ответить

Wasilich

Дата: Понедельник, 01.04.2013, 18:36 |
Сообщение № 8

Группа: Друзья

Ранг: Старожил

Сообщений: 1232


Репутация:

326

±

Замечаний:
0% ±


2003

Цитата (Лехаа)

хорошо бы показывал на форме сколько совпадений нашлось

Цитата (Лехаа)

прошу помощи т.к. сам еще слабоват в написании своих макросов

Тренируйтесь. smile
ПС Какой ужас, не то вложил, исправился.

Сообщение отредактировал WasilicПонедельник, 01.04.2013, 19:30

 

Ответить

_Boroda_

Дата: Среда, 03.04.2013, 15:30 |
Сообщение № 9

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16618


Репутация:

6465

±

Замечаний:
0% ±


2003; 2007; 2010; 2013 RUS


Скажи мне, кудесник, любимец ба’гов…
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

 

Ответить

jijik2

Дата: Среда, 08.04.2015, 14:04 |
Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 31


Репутация:

0

±

Замечаний:
40% ±


Excel 2010

Wasilic, очень удобная форма,но не как не смогла адаптировать под свой нужды,не посмотрите???

 

Ответить

ShAM

Дата: Среда, 08.04.2015, 19:21 |
Сообщение № 11

Группа: Друзья

Ранг: Старожил

Сообщений: 1347


Репутация:

249

±

Замечаний:
0% ±


Excel 2010

Wasilic может и посмотрел бы, но, стесняюсь спросить, куда?

 

Ответить

275

28 августа 2009 года

pashulka

985 / / 19.09.2004

Код:

Private Sub CommandButton1_Click()
    iText$ = TextBox1
    If iText$ <> «» Then
       With ThisWorkbook.Worksheets(1).[B:B]
            ‘Укажите нужную рабочую книгу и рабочий лист
            Dim iCell As Range
            Set iCell = .Find(iText$, , xlValues, xlPart)
            If Not iCell Is Nothing Then
               iAddress$ = iCell.Address
               ListBox1.Clear
               Do
                    ListBox1.AddItem
                    ListBox1.List(iCount&, 0) = iCell(1, 1) ‘iCell
                    ListBox1.List(iCount&, 1) = iCell(1, 2)
                    ListBox1.List(iCount&, 2) = iCell(1, 5)
                    ‘и т.д.
                    iCount& = iCount& + 1
                    Set iCell = .FindNext(iCell)
               Loop While iAddress$ <> iCell.Address
            End If
       End With
    Else
       TextBox1.SetFocus
       MsgBox «Необходим образец для поиска», , «»
    End If
End Sub

Примечание :
— если Вам непривычен синтаксис Item(RowIndex, ColumnIndex), то, к примеру, вместо iCell(1, 2) можно использовать iCell.Offset(, 1)/iCell.Offset(0, 1), только учтите, что смещение зависит от наличия об’единённых ячеек.
— при наличии восьми столбцов имеет смысл организовать их заполнение с помощью цикла.
— если этот вариант, по каким-то причинам, не устроит, то заполнить список можно также использовав свойство List

Понравилась статья? Поделить с друзьями:
  • Vba excel поиск нескольких значений
  • Vba excel поиск значения по всем листам
  • Vba excel поиск значения в таблице
  • Vba excel поиск дубликатов в столбце
  • Vba excel поиск всех файлов