Buscador para excel con Visual Basic 6 buscar datos en celdas

[fernandoasr.8]

Hola buen día.
Soy nuevo aquí en el foro, así que no estoy muy seguro de la mecánica en que se maneja, espero no fallar en algo.
Bueno mi asunto es, quiero hacer un buscador en visual basic 6, este buscador tiene que buscar un dato en una hoja de excel, decirme en que hoja y celda está y poder cambiar al siguiente resultado.
Al encontrar un resultado que en unos TextBox me muestre la fila del resultado que encontró.
Ejemplo:
Encontró el valor en la celda A3, el Text1 sea A1, Text2 sea A2, Text3 sea A3, etc. y al cambiar al siguiente valor que encontró los textBox también cambien.
Espero haber sido claro y me puedan ayudar, estoy un poco desesperado por este asunto.
De antemano muchas gracias por la ayuda que me puedan proporcionar.
Saludos.

[Alex Rodríguez]

Hola, no entiendo bien qué quiere decir: "Encontró el valor en la celda A3, el Text1 sea A1, Text2 sea A2, Text3 sea A3, etc. y al cambiar al siguiente valor que encontró los textBox también cambien."

¿El código lo tienes que crear con VBA o tiene que ser una aplicación independiente? ¿Tienes que poder elegir el fichero o siempre vas a trabajar con un mismo fichero?

[fernandoasr.8]

Es un fichero único no hay necesidad de cambiarlo. Lo tengo que realizar en Visual Basic 6, para crear el ejecutable y que no haya necesidad de abrir esa hoja de Excel después.

Digamos que tengo un formulario con cinco cuadros de texto. En uno ingresaré el dato que quiero buscar en Excel. Al encontrar un dato en la hoja de Excel, que me muestre en el cuadro de texto 2 la hoja en donde encontró el dato. En los otros cuadros de texto el valor de las celdas de la fila de la celda donde encontró el dato.
tengo información solo en tres columnas, y el valor que me encontró está en la celda A3, que me muestre en el cuadro de texto 3 el valor de A1, en el cuadro de texto 4 el valor de A2 y finalmente en el cuadro de texto 5 el valor de A3.

Código: [Seleccionar]


Text2.Text = .ActiveSheet.Name
Text3.Text = .Cells(.ActiveCell.Row, 1).Value
Text4.Text = .Cells(.ActiveCell.Row, 2).Value
Text5.Text = .Cells(.ActiveCell.Row, 3).Value


Al igual implementar dos botones para mostrar el resultado siguiente y el resultado anterior y que al presionarlos el valor de los cuadros de texto cambien según sea el resultado siguiente o el anterior.
Espero haber sido más claro esta vez.
Gracias.

[Alex Rodríguez]

He probado este código y a mí me funciona correctamente para buscar un texto dentro de un archivo excel (el texto se escribe en un textBox denominado Text1; además tenemos un botón denominado cmdSearch y un archivo excel en la ruta "C:\Users\Asus\Desktop\prueba.xls"). Ahora mismo el resultado se muestra en un msgbox, pero puedes hacer que se muestre de otras formas...

Código: [Seleccionar]

Option Explicit
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim strResults, strSearch As String

Private Sub cmdSearch_Click()
Dim rngfnd As Range
Dim txtSearch As String
txtSearch = Text1

Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("C:\Users\Asus\Desktop\prueba.xls")
Set ws = wb.Worksheets("Hoja1") 'Nombre de la hoja donde vamos a buscar

Set rngfnd = ws.UsedRange.Find(What:=txtSearch, After:=ws.UsedRange.Cells(ws.UsedRange.Cells.Count), LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
If Not rngfnd Is Nothing Then
   ' Mostrar el resultado
   MsgBox "Texto encontrado en la celda: " & rngfnd.Address
Else
   MsgBox "Texto no encontrado en el archivo Excel"
End If

End Sub

[Alex Rodríguez]

Tener en cuenta que para poder manipular archivos de Excel desde Visual Basic 6 hay que activar la librería Excel de Visual Basic 6. Esto se hace desde el menú Proyecto -- > Referencias -- > buscar "Microsoft Excel x Object Library" donde la x es un número, por ejemplo 12.0.

La seleccinamos y pulsamos aceptar (hecho esto ya podemos ejecutar el código.)

[fernandoasr.8]

Todo está perfecto. El único problema que tengo es que no debo seleccionar la hoja a buscar. Tiene que buscar en todo el documento y decirme en que hoja está. Sin tener que decirle en que hoja buscar.

[helvetico26]

Habría que recorrer todas las hojas del documento con un bucle y mostrar donde se encuentren resultados.

[Alex Rodríguez]

Código para búsqueda en todas las hojas de excel:

Código: [Seleccionar]

Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim strResults, strSearch As String
Dim encontrado As Boolean

Private Sub cmdSearch_Click()
Dim rngfnd As Range
Dim txtSearch As String
txtSearch = Text1
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("C:\Users\Asus\Desktop\prueba2.xls")

For Each ws In ActiveWorkbook.worksheets
Set rngfnd = ws.UsedRange.Find(What:=txtSearch, After:=ws.UsedRange.Cells(ws.UsedRange.Cells.Count), LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
If Not rngfnd Is Nothing Then
   ' Mostrar el resultado
   encontrado = True
   MsgBox "Texto encontrado en la hoja " & ws.Name & " y en la celda: " & rngfnd.Address
End If
Next ws
If encontrado = False Then
   MsgBox "Texto no encontrado en el archivo Excel"
End If
End Sub

[fernandoasr.8]

Muchas gracias, lo pruebo y comento el resultado que obtuve. Gracias por la ayuda.

[fernandoasr.8]

Modifique el código que me brindaron, y funciona muy bien, el único problema que tengo ahora es cambiar el resultado siguiente y el anterior.
Adjunto el código para ver si podemos buscar el error que estoy cometiendo. Gracias.

Código: [Seleccionar]

Private Sub Form_Load()
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("C:\Documents and Settings\Gugonzalez\Mis documentos\dssdsdsdsd\datos.xlsx")
End Sub

Private Sub Buscar_Click()
'BOTON Buscar'
Dim rngfnd As Range
Dim txtSearch As String
encontrado = False
txtSearch = Text1
For Each ws In ActiveWorkbook.Worksheets
Set rngfnd = ws.UsedRange.Find(What:=txtSearch, After:=ws.UsedRange.Cells(ws.UsedRange.Cells.Count), LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False)
        If Not rngfnd Is Nothing Then
            encontrado = True
            Text2.Text = rngfnd.Worksheet.Name
            Text3.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 1).Value
            Text4.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 2).Value
            Text5.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 3).Value
        End If
Next ws
If encontrado = False Then
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    MsgBox "Texto no encontrado en el archivo Excel"
End If
End Sub

Private Sub Siguiente_Click()
'BOTON Siguiente'
         On Local Error Resume Next
         For Each ws In ActiveWorkbook.Worksheets
                Set rngfnd = ws.UsedRange.FindNext(After:=ActiveCell)
                Text2.Text = rngfnd.Worksheet.Name
                Text3.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 1).Value
                Text4.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 2).Value
                Text5.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 3).Value
        Next ws
End Sub

Private Sub Anterior_Click()
'BOTON Anterior'
         On Local Error Resume Next
         For Each ws In ActiveWorkbook.Worksheets
                Set rngfnd = ws.UsedRange.FindPrevious(After:=ActiveCell)
                Text2.Text = rngfnd.Worksheet.Name
                Text3.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 1).Value
                Text4.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 2).Value
                Text5.Text = rngfnd.Worksheet.Cells(rngfnd.Row, 3).Value
         Next ws
End Sub

Private Sub Salir_Click()
'BOTON Salir'
xlApp.Parent.Quit
End
End Sub



[Alex Rodríguez]

No está depurado, pero con este código creo que se puede construir la idea de lo que quieres hacer, hay cosas que faltan por completar y cosas que habría que mejorar, pero lo esencial que es recorrer todos los resultados lo hace, a partir de ahí una idea es guardarlos en un array, pero también podría hacerse de otras maneras, quizás más sencillas:

Código: [Seleccionar]

Option Explicit
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim strResults, strSearch As String
Dim encontrado As Boolean
Dim contador As Integer
Dim rngfnd As Range
Dim txtSearch As String
Dim resultadosHoja(50) As String
Dim resultadoCelda(50) As String

Private Sub Form_Load()
contador = 0
End Sub

Private Sub cmdSearch_Click()
txtSearch = Text1
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("C:\Users\Asus\Desktop\prueba.xls")
For Each ws In ActiveWorkbook.Worksheets
Set rngfnd = ws.UsedRange.Find(What:=txtSearch, After:=ws.UsedRange.Cells(ws.UsedRange.Cells.Count), LookIn:= _
       xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
       xlNext, MatchCase:=False, SearchFormat:=False)
Do While Not rngfnd Is Nothing And contador < 20
   encontrado = True
  MsgBox ("Encontrado resultado en hoja" & ws.Name & " y celda " & rngfnd.Address & " contador = " & contador)
   resultadosHoja(contador) = "" & ws.Name
   resultadoCelda(contador) = rngfnd.Address
   Set rngfnd = ws.UsedRange.FindNext(After:=rngfnd)
   contador = contador + 1
Loop
Next ws
contador = 0
If encontrado = False Then
   MsgBox "Texto no encontrado en el archivo Excel"
End If
End Sub
Private Sub CommandSalir_Click()
'BOTON Salir'
xlApp.Workbooks.Close
xlApp.Quit
Application.Quit
xlApp.Parent.Quit
End
End Sub

[fernandoasr.8]

Bueno, el siguiente código ya es con más modificaciones como me recomendaron. El problema que hay ahora es que solo encuentra el primer resultado de cada hoja. ¿Tendría que poner otro for para que me recorra los resultados de cada hoja?
Gracias.

Código: [Seleccionar]

Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim encontrado As Boolean
Dim contador As Integer
Dim resultadosHoja(100) As String
Dim resultadosValue(100, 50) As String
Dim total As Integer
Dim rngfnd As Range

Private Sub Form_Load()
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("E:\datos.xlsx")
End Sub

Private Sub Buscar_Click()
'BOTON Buscar'
If Text1.Text = "" Then
MsgBox "Ingrese un valor a buscar"
Else
contador = 1
total = 0
Dim txtSearch As String
encontrado = False
txtSearch = Text1
For Each ws In ActiveWorkbook.Worksheets
Set rngfnd = ws.UsedRange.Find(What:=txtSearch, After:=ws.UsedRange.Cells(ws.UsedRange.Cells.Count), LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
       If Not rngfnd Is Nothing Then
        encontrado = True
resultadosHoja(contador) = ws.Name
resultadosValue(contador, 1) = rngfnd.Worksheet.Cells(rngfnd.Row, 1).Value
resultadosValue(contador, 2) = rngfnd.Worksheet.Cells(rngfnd.Row, 2).Value
resultadosValue(contador, 3) = rngfnd.Worksheet.Cells(rngfnd.Row, 3).Value
contador = contador + 1
End If
Next ws
total = contador - 1
If encontrado = False Then
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Siguiente.Enabled = False
Anterior.Enabled = False
MsgBox "Texto no encontrado en el archivo Excel"
Else
contador = 1
Text2.Text = resultadosHoja(contador)
Text3.Text = resultadosValue(contador, 1)
Text4.Text = resultadosValue(contador, 2)
Text5.Text = resultadosValue(contador, 3)
Text7 = total
Text6 = contador
Siguiente.Enabled = True
Anterior.Enabled = True
End If
End If
End Sub

Private Sub Siguiente_Click()
'BOTON Siguiente'
contador = contador + 1
If contador > total Then
    contador = 1
End If
If contador <= total Then
Text2.Text = resultadosHoja(contador)
Text3.Text = resultadosValue(contador, 1)
Text4.Text = resultadosValue(contador, 2)
Text5.Text = resultadosValue(contador, 3)
End If
Text6 = contador
Text7 = total
End Sub

Private Sub Anterior_Click()
'BOTON Anterior'
contador = contador - 1
If contador < 1 Then
    contador = total
End If
If contador >= 1 Then
Text2.Text = resultadosHoja(contador)
Text3.Text = resultadosValue(contador, 1)
Text4.Text = resultadosValue(contador, 2)
Text5.Text = resultadosValue(contador, 3)
End If
Text6 = contador
Text7 = total
End Sub

Private Sub Salir_Click()
'BOTON Salir'
xlApp.Workbooks.Close
xlApp.Quit


[Alex Rodríguez]

Con este código logro que encuentre todos los resultados, aunque me saltan algunos errores en determinados casos y además me repite los resultados no tengo del todo claro por qué pero creo que por aquí se podría ir buscando una solución

Código: [Seleccionar]

Option Explicit
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim strResults, strSearch As String
Dim encontrado As Boolean
Dim contador As Integer
Dim rngfnd As Range
Dim txtSearch As String
Dim resultadosHoja(50) As String
Dim resultadoCelda(50) As String

Private Sub Form_Load()
contador = 0
End Sub

Private Sub cmdSearch_Click()
txtSearch = Text1
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open("C:\Users\Asus\Desktop\prueba.xls")
For Each ws In ActiveWorkbook.Worksheets
Set rngfnd = ws.UsedRange.Find(What:=txtSearch, After:=ws.UsedRange.Cells(ws.UsedRange.Cells.Count), LookIn:= _
       xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
       xlNext, MatchCase:=False, SearchFormat:=False)
Do

If (rngfnd.Address <> "") Then
'MsgBox ("prueba " & rngfnd.Address)
   encontrado = True
  MsgBox ("Encontrado resultado en hoja" & ws.Name & " y celda " & rngfnd.Address & " contador = " & contador)
   resultadosHoja(contador) = "" & ws.Name
   resultadoCelda(contador) = rngfnd.Address
   Set rngfnd = ws.UsedRange.FindNext(After:=rngfnd)
   contador = contador + 1
End If
Loop While Not rngfnd Is Nothing And contador < 10
MsgBox ("Ws vale " & ws.Name & "paso al next y siguiente ws")

Next ws
contador = 0
If encontrado = False Then
   MsgBox "Texto no encontrado en el archivo Excel"
End If
End Sub
Private Sub CommandSalir_Click()
'BOTON Salir'
xlApp.Workbooks.Close
xlApp.Quit
Application.Quit
xlApp.Parent.Quit
End
End Sub

[fernandoasr.8]

Muchas gracias. Perdón por la tardanza en contestar de nuevo. El programa ya funcionó perfectamente y como yo quería. Ahora solamente me falta hacerlo funcionar en Windows 7, ya que el programa lo hice en XP. Igual muchas gracias por las respuestas, me fueron de mucha ayuda.

[Alex Rodríguez]

Si puedes poner el código que te funcionó te lo agradecemos pues será útil si se presenta el mismo problema, saludos

[fernandoasr.8]

Claro, me funcionó el siguiente código.

Código: [Seleccionar]

Option Explicit
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim encontrado As Boolean
Dim contador As Integer
Dim resultadosHoja(10000) As String
Dim resultadosValue(10000, 10) As String
Dim total As Integer
Dim rngfnd As Range
Dim primerres As String
Dim fila(10000) As String

Private Sub Buscarr_Click()
'BOTON Buscar'
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open(PRINCIPAL.CommonDialog1.FileName)
If Text1.Text = "" Then
MsgBox "Ingrese un valor a buscar"
Else
contador = 1
total = 0
Dim txtSearch As String
encontrado = False
txtSearch = Text1
For Each ws In wb.Worksheets
On Error Resume Next
Set rngfnd = ws.UsedRange.Find(What:=txtSearch, After:=ws.UsedRange.Cells(ws.UsedRange.Cells.Count), LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        On Error Resume Next
        primerres = rngfnd.Address
        If primerres <> "" Then
        Do
            If Not rngfnd Is Nothing Then
                encontrado = True
                resultadosHoja(contador) = ws.Name
                resultadosValue(contador, 1) = rngfnd.Worksheet.Cells(rngfnd.Row, 1).Value
                resultadosValue(contador, 2) = rngfnd.Worksheet.Cells(rngfnd.Row, 2).Value
                resultadosValue(contador, 3) = rngfnd.Worksheet.Cells(rngfnd.Row, 3).Value
                resultadosValue(contador, 4) = rngfnd.Worksheet.Cells(rngfnd.Row, 4).Value
                resultadosValue(contador, 5) = rngfnd.Worksheet.Cells(rngfnd.Row, 5).Value
                resultadosValue(contador, 6) = rngfnd.Worksheet.Cells(rngfnd.Row, 6).Value
                resultadosValue(contador, 7) = rngfnd.Worksheet.Cells(rngfnd.Row, 7).Value
                resultadosValue(contador, 8) = rngfnd.Worksheet.Cells(rngfnd.Row, 8).Value
                resultadosValue(contador, 9) = rngfnd.Worksheet.Cells(rngfnd.Row, 9).Value
                resultadosValue(contador, 10) = rngfnd.Worksheet.Cells(rngfnd.Row, 10).Value
                fila(contador) = rngfnd.Row
                contador = contador + 1
                Set rngfnd = ws.UsedRange.FindNext(After:=rngfnd)
            End If
        Loop While rngfnd.Address <> primerres
        End If
Next ws
total = contador - 1
If encontrado = False Then
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
rescam.Text = ""
resfij.Text = ""
Siguiente.Enabled = False
Editar.Enabled = False
Anterior.Enabled = False
Label15.Visible = False
Imprimirr.Enabled = False
Guardar.Enabled = False
MsgBox "Texto no encontrado en el archivo Excel"
Else
contador = 1
Text2.Text = resultadosHoja(contador)
Text3.Text = resultadosValue(contador, 1)
Text4.Text = resultadosValue(contador, 2)
Text5.Text = resultadosValue(contador, 3)
Text6.Text = resultadosValue(contador, 4)
Text7.Text = resultadosValue(contador, 5)
Text8.Text = resultadosValue(contador, 6)
Text9.Text = resultadosValue(contador, 7)
Text10.Text = resultadosValue(contador, 8)
Text11.Text = resultadosValue(contador, 9)
Text12.Text = resultadosValue(contador, 10)
resfij = total
rescam = contador
Label15.Visible = True
Siguiente.Enabled = True
Editar.Enabled = True
Anterior.Enabled = True
Imprimirr.Enabled = True
End If
End If
xlApp.Workbooks.Close
xlApp.Quit
Application.Quit
xlApp.Parent.Quit
End Sub

Private Sub Siguiente_Click()
'BOTON Siguiente'
contador = contador + 1
If contador > total Then
    contador = 1
End If
If contador <= total Then
Text2.Text = resultadosHoja(contador)
Text3.Text = resultadosValue(contador, 1)
Text4.Text = resultadosValue(contador, 2)
Text5.Text = resultadosValue(contador, 3)
Text6.Text = resultadosValue(contador, 4)
Text7.Text = resultadosValue(contador, 5)
Text8.Text = resultadosValue(contador, 6)
Text9.Text = resultadosValue(contador, 7)
Text10.Text = resultadosValue(contador, 8)
Text11.Text = resultadosValue(contador, 9)
Text12.Text = resultadosValue(contador, 10)
End If
rescam = contador
resfij = total
End Sub

Private Sub Anterior_Click()
'BOTON Anterior'
contador = contador - 1
If contador < 1 Then
    contador = total
End If
If contador >= 1 Then
Text2.Text = resultadosHoja(contador)
Text3.Text = resultadosValue(contador, 1)
Text4.Text = resultadosValue(contador, 2)
Text5.Text = resultadosValue(contador, 3)
Text6.Text = resultadosValue(contador, 4)
Text7.Text = resultadosValue(contador, 5)
Text8.Text = resultadosValue(contador, 6)
Text9.Text = resultadosValue(contador, 7)
Text10.Text = resultadosValue(contador, 8)
Text11.Text = resultadosValue(contador, 9)
Text12.Text = resultadosValue(contador, 10)
End If
rescam = contador
resfij = total
End Sub

Lo puse con las modificaciones que necesitaba según mi formulario, pero en sí ahí esta todo el código. Guarde los resultados en una matriz y me fue más fácil poder mostrarlos y cambiar de uno a otro.
De nuevo, muchas gracias por su ayuda.