Excel - Buscar en una hoja de excel por medio de vba

 
Vista:

Buscar en una hoja de excel por medio de vba

Publicado por Claudio Cruz (43 intervenciones) el 07/06/2007 23:52:50
Buenas tardes.
Estoy desarrollando una aplicación en excel conformada por una serie de libros.
Bien, en una de ellas, se encuentra una base de datos de clientes con información como clave (ID) nombre, direccion, entre otras cosas.
He logrado introducir dicha información en esa base de datos (hoja de calculo) por medio de los userform, pero ahora bien, deseo efectuar una busqueda en esa misma base de datos de alguno de los registros ya guardados.
Como esto se hace sin permitir el acceso directo del usuario en dicha hoja de calculo, el resultado de la busqueda se informa mediante los MsgBox y si el usuario esta de acuerdo con el resultado ahi finaliza la busqueda, pero si no es asi, el procedimiento de busqueda debe repetirse hasta que el usuario este de acuerdo.
¿Alguna idea de cómo hacer esto?
Espero no haberlo enredado.

Agradezco mucho su atención y ayuda.

Saludos.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Buscar en una hoja de excel por medio de vba

Publicado por JuanC (792 intervenciones) el 08/06/2007 00:52:25
alguna vez... hace mucho tiempo hice esto...
por ahí te sirve para hacer la búsqueda (al menos orientarte...)

Private Function Buscar(Valor As String) As String
Dim c As Range
Dim A$, B$, direcciones$
Dim count&
count = 0
direcciones = ""
A = Selection.Address
ActiveSheet.UsedRange.Select
With Selection
Set c = .Find(Valor, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=False)
If Not c Is Nothing Then
B = c.Address
Do
Set c = .FindNext(c)
If c.Address <> A Then
If count Then
direcciones = direcciones & "; " & c.Address(False, False)
Else: direcciones = c.Address(False, False)
End If
count = count + 1
End If
Loop While Not c Is Nothing And c.Address <> B
End If
End With
Buscar = direcciones
Range(A).Select
Set c = Nothing
End Function

Saludos desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Buscar en una hoja de excel por medio de vba

Publicado por Claudio Cruz (43 intervenciones) el 11/06/2007 17:32:49
Buen día Juan.

Mira, ya le he dado vueltas a tu propuesta pero no logro integrarlo.
Tengo esto:
Un userform con dos botones de opción y dos campos de texto, la búsqueda se hace en base a dos tipos de búsqueda, por rfc o por nombre, si escogemos uno de los botones habilitará o deshabilitará alguno de los campos de texto.
Bien, en el código del botón OK tengo lo siguiente:

Private Sub cmdOK_Click()
'
'Abrimos el Catálogo de Clientes
Sheets("CC").Visible = True
ActiveWorkbook.Sheets("CC").Activate
ActiveWindow.DisplayGridlines = False
'Asignamos el nombre CveRFC al valor del campo txtRFC
Dim CveRFC As String
CveRFC = txtRFC.Value
'Asignamos el nombre NomDen al valor del campo txtNombre
Dim NomDen As String
NomDen = txtNombre.Value
If optBuscaRFC = True Then
'Iniciamos la búsqueda por RFC
Dim RFCIni As String
RFCIni = "$D$7"
Dim RFCFin As String
Range(RFCIni).Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
RFCFin = ActiveCell.Offset(-1, 0).Address

'Establecemos nuestro rango de búsqueda e iniciamos con la operación
ActiveWorkbook.Names.Add Name:="RanBusqRFC", RefersToR1C1:=Range(RFCIni, RFCFin)
Application.Goto Reference:="RanBusqRFC"
Set BuskRFC = Selection.Find(What:=CveRFC, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
'Si el RFC que ingresamos existe en nuestro catálogo, terminamos la búsqueda
If Not BuskRFC Is Nothing Then
BuskRFC.Activate
Dim CveClisRFC As String
CveClisRFC = (ActiveCell.Offset(0, -3).Value)
Dim NomClisRFC As String
NomClisRFC = UCase(ActiveCell.Offset(0, -1).Value)
Dim ClaveRFC As String
ClaveRFC = UCase(ActiveCell.Value)
'Informamos a quién pertenece el RFC
MsgBox "Nombre del Cliente: " & NomClisRFC & Chr(13) & "R.F.C.: " _
& ClaveRFC, vbInformation, "Resultados de la búsqueda"
Dim ResponseRFC
ResponseRFC = MsgBox("¿Es correcto?", vbYesNo + vbQuestion, "Verificando información")
If ResponseRFC = vbYes Then
MsgBox "La clave del cliente es: " & CveClisRFC, vbInformation, "Tome nota..."
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
Else
'AQUI VA ALGO QUE NOS PERMITA CONTINUAR CON LA BUSQUEDA MIENTRAS EL USUARIO SIGA CONTESTANDO NO, O HASTA QUE LLEGUE LA ÚLTIMA CELDA DEL RANGO SELECCIONADO.
'Selection.FindNext (CveRFC)
Unload Me
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
End If
Else
'Pero si no encontramos nada informamos de ello
Unload Me
MsgBox "La clave de R.F.C. que ingresó no existe", vbCritical, _
"R.F.C. no existe"
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
End If

Else
'Iniciamos la búsqueda por nombre

Dim NomIni As String
NomIni = "$C$7"
Dim NomFin As String
Range(NomIni).Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
NomFin = ActiveCell.Offset(-1, 0).Address

'Establecemos nuestro rango de búsqueda e iniciamos con la operación
ActiveWorkbook.Names.Add Name:="RanBusqNom", _
RefersToR1C1:=Range(NomIni, NomFin)
Application.Goto Reference:="RanBusqNom"
Set BuskNom = Selection.Find(What:=NomDen, After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'Si el nombre que ingresamos existe en nuestro catálogo, terminamos la búsqueda
If Not BuskNom Is Nothing Then
BuskNom.Activate
Dim CveClisNom As String
CveClisNom = (ActiveCell.Offset(0, -2).Value)
Dim NomClisNom As String
NomClisNom = UCase(ActiveCell.Value)
Dim RFCsNom As String
RFCsNom = UCase(ActiveCell.Offset(0, 1).Value)
MsgBox "Nombre del Cliente: " & NomClisNom & Chr(13) & "R.F.C.: " & _
RFCsNom, vbInformation, "Resultados de la búsqueda"
Dim ResponseNom
ResponseNom = MsgBox("¿Es correcto?", vbYesNo + vbQuestion, "Verificando información")
If ResponseNom = vbYes Then
MsgBox "La clave del cliente es: " & CveClisNom, _
vbInformation, "Tome nota..."
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
Else
'AQUI VA ALGO QUE NOS PERMITA CONTINUAR CON LA BUSQUEDA MIENTRAS EL USUARIO SIGA CONTESTANDO NO, O HASTA QUE LLEGUE LA ÚLTIMA CELDA DEL RANGO SELECCIONADO.
'Selection.FindNext (NomDen)
Unload Me
Sheets("CC").Visible = False
Sheets("Detalle").Activate
Exit Sub
End If
End If
End If
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Buscar en una hoja de excel por medio de vba

Publicado por JuanC (792 intervenciones) el 12/06/2007 01:48:28
Le hice algunos cambios... aún quedan detalles... pero creo que es lo que
necesitás...

Option Explicit

Private Sub cmdOK_Click()
Dim CveRFC$, NomDen$

'Abrimos el Catálogo de Clientes
Sheets("CC").Visible = True
ActiveWorkbook.Sheets("CC").Activate
ActiveWindow.DisplayGridlines = False

'Asignamos el nombre CveRFC al valor del campo txtRFC
CveRFC = txtRFC.Value
'Asignamos el nombre NomDen al valor del campo txtNombre
NomDen = txtNombre.Value

If optBuscaRFC = True Then
'Iniciamos la búsqueda por RFC
Call BuscarRFC(CveRFC, NomDen)
Else
'Iniciamos la búsqueda por nombre
Call BuscarNombre(NomDen)
End If

Unload Me

Sheets("CC").Visible = False
Sheets("Detalle").Activate
End Sub

Private Sub BuscarRFC(CveRFC As String, NomDen As String)
Dim RFCIni$, RFCFin$, sFirst$
Dim CveClisRFC$, NomClisRFC$, ClaveRFC$
Dim ResponseRFC%
Dim BuskRFC As Range

RFCIni = "$D$7"
Range(RFCIni).Select

Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

RFCFin = ActiveCell.Offset(-1, 0).Address

'Establecemos nuestro rango de búsqueda e iniciamos con la operación
ActiveWorkbook.Names.Add Name:="RanBusqRFC", RefersToR1C1:=Range(RFCIni, RFCFin)
Application.Goto Reference:="RanBusqRFC"

Set BuskRFC = Selection.Find(What:=CveRFC, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

'Si el RFC que ingresamos existe en nuestro catálogo, terminamos la búsqueda
If Not BuskRFC Is Nothing Then
sFirst = BuskRFC.Address

Begin:
BuskRFC.Activate

With ActiveCell
CveClisRFC = .Offset(0, -3).Value
NomClisRFC = UCase(.Offset(0, -1).Value)
ClaveRFC = UCase(.Value)
End With

'Informamos a quién pertenece el RFC
MsgBox "Nombre del Cliente: " & NomClisRFC & vbCrLf & "R.F.C.: " _
& ClaveRFC, vbInformation, "Resultados de la búsqueda"

ResponseRFC = MsgBox("¿Es correcto?", vbYesNo + vbQuestion, "Verificando información")

If ResponseRFC = vbYes Then
MsgBox "La clave del cliente es: " & CveClisRFC, vbInformation, "Tome nota..."
Exit Sub
Else
'AQUI VA ALGO QUE NOS PERMITA CONTINUAR CON LA BUSQUEDA MIENTRAS EL USUARIO SIGA CONTESTANDO NO
'O HASTA QUE LLEGUE LA ÚLTIMA CELDA DEL RANGO SELECCIONADO.
Set BuskRFC = Selection.FindNext(BuskRFC)
If Not BuskRFC Is Nothing And sFirst <> BuskRFC.Address Then
GoTo Begin
End If
End If
Else
'Pero si no encontramos nada informamos de ello
MsgBox "La clave de R.F.C. que ingresó no existe", vbCritical, _
"R.F.C. no existe"
End If

Set BuskRFC = Nothing
End Sub

Private Sub BuscarNombre(NomDen As String)
'...
End Sub

Saludos desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Buscar en una hoja de excel por medio de vba

Publicado por Claudio Cruz (43 intervenciones) el 12/06/2007 06:22:57
Que tal Juan.

Fijate que esa idea tenia en cabeza, llamar la funcion busqueda desde "fuera", pero simplemente no sabia cómo hacerlo.
Estuve observando tu código y lo complementé con otro que vi en otro lado, así que conseguí lo siguiente:

Private Sub BuscarRFC(CveRFC As String, NomDen As String)
Dim RFCIni$, RFCFin$, frstMatch$
Dim CveClisRFC$, NomClisRFC$, ClaveRFC$
Dim ResponseRFC%

RFCIni = "$D$7"
Range(RFCIni).Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
RFCFin = ActiveCell.Offset(-1, 0).Address

'Establecemos nuestro rango de búsqueda e iniciamos con la operación
ActiveWorkbook.Names.Add Name:="RanBusqRFC", RefersToR1C1:=Range(RFCIni, RFCFin)
Application.Goto Reference:="RanBusqRFC"

On Error GoTo NotFound

Selection.Find(What:=CveRFC, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Activate
frstMatch = ActiveCell.Address

'Si el RFC que ingresamos existe en nuestro catálogo, comenzamos a informar de los
'resultados
Do
With ActiveCell
CveClisRFC = .Offset(0, -3).Value
NomClisRFC = UCase(.Offset(0, -1).Value)
ClaveRFC = UCase(.Value)
End With

ResponseRFC = MsgBox("Nombre: " & NomClisRFC & vbCrLf & "R.F.C.: " & ClaveRFC, _
vbYesNo + vbQuestion, "¿Es correcto?")
If ResponseRFC = vbYes Then
MsgBox "La clave del cliente es: " & CveClisRFC, vbInformation, "Tome nota..."
Exit Sub
End If
Selection.Find(What:=CveRFC, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Activate
Loop Until ActiveCell.Address = frstMatch
MsgBox "La entrada no arrojó resultados satisfactorios", vbCritical, _
"Búsqueda fallida"
Exit Sub

'Pero si no encontramos nada informamos de ello
NotFound:
MsgBox "La clave de R.F.C. que ingresó no existe", vbCritical, _
"R.F.C. no existe"
Exit Sub

End Sub
Ya lo he probado y todo funciona tal y como lo imaginé.
Esto no hubiera sido posible sin tu ayuda, muchas gracias Juan.

El código del boton OK no lo modifiqué lo dejé tal y como me sugeriste.

Saludos cordiales
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Buscar en una hoja de excel por medio de vba

Publicado por marco chaman (2 intervenciones) el 20/05/2008 01:22:22
Tengo una macro pero en Application.Goto Reference:= , quiero hacer una referencia a una celda de otra hoja, pero esta se mueve a la hoja y continua los con la macro en esa hoja y me hace un reverendo desastre,

Sheets(11).Cells(4, 6) = ""
Sheets("Conciliado").Select
Application.Goto reference:=Sheets(11).Cells(4, 6) ''' eh aqui el cambio que quiero, lo que pasa es que dese controlarla desde unos parámetros que se incluyan en una hoja11 Ayuda Helpme!!!
'
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.EntireRow.Hidden = False
Sheets("Proceso").Visible = True
Application.Goto reference:="R1C1:R6000C26" ''' "R1C1:R6000C26"
Selection.ClearContents
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Sheets("Aux").Select
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar