RE:Buscar en una hoja de excel por medio de vba
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