Developing.ru

Код: Выделить всё

Sub bb()
Dim ac As Range
Set ac = ActiveCell
Worksheets.Select
Range("C:C,I:I,O:O").Select
On Error Resume Next
Selection.Find(InputBox("Введите слово"), , xlFormulas, xlPart).Select
If Err Then
  ac.Parent.Activate
  ac.Select
  MsgBox "Не найдено"
End If
End Sub

Код: Выделить всё

Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    Cells(ListBox1.Value, 1).Select
End Sub

Код: Выделить всё

Private Sub TextBox1_Change()
Dim j As Long, i As Long
ListBox1.Clear
'при отсутствии символов для поиска - выход
   If Len(TextBox1.Value) = 0 Then Exit Sub   
   j = 0
'для одного символа поиск осуществляем по первой букве
If Len(TextBox1.Value) = 1 Then
    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
        If UCase(Left(Cells(i, 1), 1)) = UCase(TextBox1.Value) Then
            ListBox1.AddItem i
            ListBox1.List(j, 1) = Cells(i, 1)
            j = j + 1
        End If
    Next i
    'если найден только один эл-т, то переходим к нему
    If j = 1 Then Cells(ListBox1.List(0, 0), 1).Select
    Exit Sub
End If 
For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
    If InStr(1, UCase(Cells(i, 1)), UCase(TextBox1.Value)) > 0 Then
       ListBox1.AddItem i
       ListBox1.List(j, 1) = Cells(i, 1)
       j = j + 1
    End If
Next i
   'если найден только один эл-т, то переходим к нему
   If j = 1 Then Cells(ListBox1.List(0, 0), 1).Select
End Sub

Код: Выделить всё

Private Sub TextBox1_Change()
    ListBox1.Clear
    
    Dim iText$, iAddress$, iCount&, iList As Worksheet, iCell As Range
    iText = TextBox1.Value
    
    If iText <> "" Then 'If Len(iText) > 0
       For Each iList In ThisWorkbook.Worksheets
           Set iCell = iList.UsedRange.Find(iText, , xlValues, xlPart)
           If Not iCell Is Nothing Then
              iAddress = iCell.Address
              Do
                   ListBox1.AddItem
                   ListBox1.List(iCount, 0) = iCell.Value
                   ListBox1.List(iCount, 1) = iCell.Address(, , , True)
                   iCount = iCount + 1
                   Set iCell = iList.UsedRange.FindNext(iCell)
              Loop While iCell.Address <> iAddress
           End If
       Next
    End If
End Sub

Private Sub ListBox1_Click()
    If ListBox1.ListIndex > -1 Then
       Application.Goto Application.Range(ListBox1.List(ListBox1.ListIndex, 1))
    End If
End Sub