Суббота, Май 30, 2020

Поиск в ячейках Текста

Option Compare Text
Sub Unhide_Columns()
    'Excel objects.
    Dim m_wbBook As Workbook
    Dim m_wsSheet As Worksheet
    Dim m_rnCheck As Range
    Dim m_rnFind As Range
    Dim m_stAddress As String, m_nxtAddress As String, CountItem As Long, CountFind As Long
    
    Dim WantToSearch As String, WantToSearchInCell As String, CellFind As Range
    Dim WerToSearch As Integer
    'Initialize the Excel objects.
    Set m_wbBook = ThisWorkbook
    Set m_wsSheet = m_wbBook.Worksheets(1)
    
    'Search the four columns for any constants.
    Set m_rnCheck = m_wsSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    WantToSearch = InputBox("Введите фамилию :")
    If WantToSearch = "" Then Exit Sub
    WantToSearchInCell = InputBox("Введите что искать в ячейках :")
    If WantToSearchInCell = "" Then Exit Sub
    WerToSearch = InputBox("Введите в каком столбце искать номер :")
    If WerToSearch = 0 Then Exit Sub
    'Retrieve all columns that contain X. If there is at least one, begin the DO/WHILE loop.
    CountItem = 0
    CountFind = 0
    With m_rnCheck
        Set m_rnFind = .Find(What:=WantToSearch, LookIn:=xlFormulas)
        If Not m_rnFind Is Nothing Then
            m_stAddress = m_rnFind.Address
            
            'Unhide the column, and then find the next X.
            Do
                CountItem = CountItem + 1
                Set m_rnFind = .FindNext(m_rnFind)
                m_nxtAddress = m_rnFind.Address
                Set CellFind = m_rnFind.Offset(0, WerToSearch)
                If CellFind.Cells.Text Like "*" & WantToSearchInCell & "*" Then
                    CountFind = CountFind + 1
                End If
            Loop While Not m_rnFind Is Nothing And m_rnFind.Address <> m_stAddress
        End If
    End With
    MsgBox "фамилий найено: " & CountItem & " совподения в ячейках найдено: " & CountFind
End Sub









 

Sub Poisk()
    Dim Sort() As String, CountSort As Double, SortRange As Range, i As Double
    Dim TempSort As String, j As Double, SortEnd() As String, CountEnd As Double
    CountSort = ActiveSheet.UsedRange.Rows.Count
    CountEnd = 0
    ReDim Sort(CountSort)
    ReDim SortEnd(CountSort)
    For Each SortRange In Selection
        Sort(i) = SortRange.Value
        i = i + 1
        If i >= CountSort Then Exit For
    Next SortRange
    
    For i = 0 To CountSort
        TempSort = Sort(i)
        If TempSort <> "" Then
            SortEnd(CountEnd) = TempSort
            For j = 0 To CountSort
                If TempSort = Sort(j) Then
                   Sort(j) = ""
                End If
            Next j
            CountEnd = CountEnd + 1
        End If
    Next i
'*******************************************************
'*******************************************************
    i = 0
    Do While SortEnd(i) <> ""
        UserForm1.ListBox1.AddItem SortEnd(i)
        i = i + 1
    Loop
    UserForm1.ComboBox1.AddItem "A(1)"
    UserForm1.ComboBox1.AddItem "B(2)"
    UserForm1.ComboBox1.AddItem "C(3)"
    UserForm1.ComboBox1.AddItem "D(4)"
    UserForm1.ComboBox1.AddItem "E(5)"
    UserForm1.ComboBox1.AddItem "F(6)"
    UserForm1.ComboBox1.AddItem "G(7)"
    UserForm1.ComboBox1.AddItem "H(8)"
    UserForm1.ComboBox1.AddItem "I(9)"
    UserForm1.ComboBox1.AddItem "J(10)"
    UserForm1.ComboBox1.AddItem "K(11)"
    UserForm1.ComboBox1.AddItem "L(12)"
    UserForm1.ComboBox1.AddItem "M(13)"
    UserForm1.ComboBox1.AddItem "N(14)"
    UserForm1.ComboBox1.AddItem "O(15)"
    UserForm1.ComboBox1.AddItem "P(16)"
    UserForm1.ComboBox1.AddItem "Q(17)"
    UserForm1.ComboBox1.AddItem "R(18)"
    UserForm1.ComboBox1.AddItem "S(19)"
    UserForm1.ComboBox1.AddItem "T(20)"
    UserForm1.ComboBox1.AddItem "U(21)"
    UserForm1.ComboBox1.AddItem "V(22)"
    UserForm1.ComboBox1.AddItem "W(23)"
    UserForm1.ComboBox1.AddItem "X(24)"
    UserForm1.ComboBox1.AddItem "Z(25)"
    UserForm1.Show
End Sub

 

Private Sub CommandButton1_Click()
Dim m_wbBook As Workbook
    Dim m_wsSheet As Worksheet
    Dim m_rnCheck As Range
    Dim m_rnFind As Range
    Dim m_stAddress As String, m_nxtAddress As String, CountItem As Long, CountFind As Long
    Dim WantToSearch As String, WantToSearchInCell As String, CellFind As Range
    Dim WerToSearch As Integer
    'Initialize the Excel objects.
    Set m_wbBook = ThisWorkbook
    Set m_wsSheet = m_wbBook.Worksheets(1)
    'Search the four columns for any constants.
    'Set m_rnCheck = m_wsSheet.UsedRange.SpecialCells(xlCellTypeConstants)
    Set m_rnCheck = Selection
    WantToSearch = UserForm1.ListBox1.Text
    If WantToSearch = "" Then Exit Sub
    WantToSearchInCell = UserForm1.TextBox1
    If WantToSearchInCell = "" Then Exit Sub
    WerToSearch = UserForm1.ComboBox1.ListIndex + 1 - Selection.Column
    If WerToSearch = 0 Then Exit Sub
    'Retrieve all columns that contain X. If there is at least one, begin the DO/WHILE loop.
    CountItem = 0
    CountFind = 0
    With m_rnCheck
        Set m_rnFind = .Find(What:=WantToSearch, LookIn:=xlFormulas)
        If Not m_rnFind Is Nothing Then
            m_stAddress = m_rnFind.Address
            'Unhide the column, and then find the next X.
            Do
                CountItem = CountItem + 1
                Set m_rnFind = .FindNext(m_rnFind)
                m_nxtAddress = m_rnFind.Address
                Set CellFind = m_rnFind.Offset(0, WerToSearch)
                If CellFind.Cells.Text Like "*" & WantToSearchInCell & "*" Then
                    CountFind = CountFind + 1
                End If
            Loop While Not m_rnFind Is Nothing And m_rnFind.Address <> m_stAddress
        End If
    End With
    MsgBox "найдено совпадений: " & CountItem & " найдено : " & CountFind
End Sub




Back to Top