Forum - VBA Excel 2010 Error 91

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Excel 2010 Error 91 (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/1457-excel-2010-error-91-a.html)

Excel 2010 Error 91

Καλησπέρα

Χρησιμοποιώ την ακόλουθη VBA για την εύρεση ονόματος. Στην περίπτωση που δεν υπάρχει το όνομα μου δίνει σφάλμα 91.
Θα παρακαλούσα κάποια βοήθεια.
Ευχαριστώ εκ των προτέρων.

Κώδικας:

'Attribute VB_Name = "FindText"

Sub FindText()
 

Dim i As Long

Dim Fnd As String

Dim fCell As Range

Dim ws As Worksheet

Dim Color As Long

Dim rngCurr As Range
 

    Fnd = InputBox("Enter text to search" & vbCr & vbCr _

            & "Click OK to search the entire workbook for all instances of the search text." & _

            " Each instance will be highlighted. This search is not case-sensitive, but it will not" & _

            " locate search text if its cell contains other text, including a formula.")
 

If Fnd = vbNullString Then

           Exit Sub

End If
 

Application.ScreenUpdating = False

Application.Dialogs(xlDialogPatterns).Show 'shows color palette

Color = ActiveCell.Interior.Color 'stores index number of selected color

ActiveCell.Interior.Color = xlNone

 'since previous line colors cell where cursor pointer is, this removes the shading from that cell

   

Application.ScreenUpdating = True
 

    Cells.Find(What:=Fnd, After:=ActiveCell, LookIn:=xlFormulas, LookAt _

        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = Color

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

        

first_pos = ActiveCell.Address 'first cell found
 

Cells.FindNext(After:=ActiveCell).Activate 'find the next cell if any
 

While ActiveCell.Address <> first_pos 'while nect cell is not the first one
 

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = Color

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    Cells.FindNext(After:=ActiveCell).Activate

    

Wend
 

End Sub

Καλημέρα Θανάση!
Επειδή τα Activate που περιέχονται στον κώδικα δεν είναι ότι γρηγορότερο,
σου προτείνω τον παρακάτω κώδικα που χρωματίζει τα κελιά που περιέχουν το κριτήριο αναζήτησης.

Κώδικας:

Option Explicit
 

Sub ColorFoundCells()

    Dim SearchString, FirstAddress As String, _

            lColor As Long, OldColor As Long, rng As Range

    SearchString = Application.InputBox("Enter text to search", Type:=2)

    If SearchString = False Then Exit Sub

    Set rng = Cells.Find(SearchString, LookIn:=xlValues)

    If Not rng Is Nothing Then

        FirstAddress = rng.Address

        OldColor = IIf(ActiveCell.Interior.ColorIndex = xlNone, _

                xlNone, ActiveCell.Interior.Color)

        If Application.Dialogs(xlDialogPatterns).Show Then

            lColor = ActiveCell.Interior.Color

            ActiveCell.Interior.Color = OldColor

        Else

            Exit Sub

        End If

    Else

        MsgBox "Search string not found!", vbInformation

        Exit Sub

    End If

    Do

        rng.Interior.Color = lColor

        Set rng = Cells.FindNext(rng)

    Loop While Not rng Is Nothing And rng.Address <> FirstAddress

End Sub

Καλή συνέχεια!

Το σφάλμα 91 το αποφεύγεις με τη γραμμή: If Not rng Is Nothing Then .... μετά από την αναζήτηση (Find ή FindNext).

Φιλικά

Τάσος

Τάσο καλημέρα,

Όπως πάντα πρόθυμος και εξυπηρετικός με τις άριστες λύσεις όλων των προβλημάτων μας.

Σε ευχαριστώ και σου εύχομαι καλή Κυριακή.

Φιλικά
Θανάσης