[Ajuda Excell] Campo de Pesquisa

[Wolfs]

Trabalho muito com uma Agenda Telefonica que criei no Excell, dividida por varias 'sheets' , criei uma 'principal' com hiperligações para as outras, mas gostava de ter um campo de pesquisa, onde por exemplo escrevia p ex: 'telepizza' e ele automaticamente 'ia' para a linha do contacto 'pesquisado', numa das 'sheets'

 

Alguem me ajuda

[HdrkAngell]

Boas ,

Deduzo que tenhas um conhecimento medio de Excell e consigas abrir o Vbasic (ALT+F11)

 

Code does the following:

1. searches for first available match in all sheets. If found then it activates the sheet and the cell in which the search string is present.

2. searches for next available match. If present then shows a msgbox with yes/no saying that there are more searches available. Do you want to continue? If yes then the next available match is shown as mentioned in point 1 and then searches for the next available match and so on till all the matches are exhausted.

3. If no matches is available then the process stops.

 

 

Dim sheetCount As Integer

Dim datatoFind

 

Sub Button1_Click()

 

Find_Data

 

End Sub

 

Private Sub Find_Data()

Dim counter As Integer

Dim currentSheet As Integer

Dim notFound As Boolean

Dim yesNo As String

 

notFound = True

 

On Error Resume Next

currentSheet = ActiveSheet.Index

datatoFind = StrConv(InputBox("Please enter the value to search for"), vbLowerCase)

If datatoFind = "" Then Exit Sub

sheetCount = ActiveWorkbook.Sheets.Count

If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)

For counter = 1 To sheetCount

Sheets(counter).Activate

 

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

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

False, SearchFormat:=False).Activate

 

If InStr(1, StrConv(ActiveCell.Value, vbLowerCase), datatoFind) Then

notFound = False

If HasMoreValues(counter) Then

yesNo = MsgBox("Do you want to continue search?", vbYesNo)

If yesNo = vbNo Then

Sheets(counter).Activate

Exit For

End If

Else

Sheets(counter).Activate

Exit For

End If

Sheets(counter).Activate

End If

Next counter

If notFound Then

MsgBox ("Value not found")

Sheets(currentSheet).Activate

End If

End Sub

 

Private Function HasMoreValues(ByVal sheetCounter As Integer) As Boolean

HasMoreValues = False

Dim str As String

Dim lastRow As Long

Dim lastCol As Long

Dim rRng As Excel.Range

 

For counter = sheetCounter + 1 To sheetCount

Sheets(counter).Activate

 

lastRow = ActiveCell.SpecialCells(xlLastCell).Row

lastCol = ActiveCell.SpecialCells(xlLastCell).Column

 

For vRow = 1 To lastRow

For vCol = 1 To lastCol

str = Sheets(counter).Cells(vRow, vCol).Text

If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then

HasMoreValues = True

Exit For

End If

Next vCol

 

If HasMoreValues Then

Exit For

End If

Next vRow

 

If HasMoreValues Then

Sheets(sheetCounter).Activate

Exit For

End If

Next counter

End Function

Editado 12 Outubro 2012 por HdrkAngell