Macro de Userform Para Buscar y reemplazar datos dentro de un Formulario y base de datos

Necesito programar un boton de busqueda para buscar Los datos ver si existen previos y modificarlos en el formulario, Y Que al cambiarlos se Pueda Cambiar en la base de datos.

Private Sub CheckBox1_Click()
'Formula para selccionar rango de edad mayor de 18
Range("D2").Select
    If CheckBox1 Then
        edad = "'" & "+18"
        ActiveCell.FormulaR1C1 = edad
    Else
    If CheckBox2 = "" And CheckBox1 = "" Then
        ActiveCell.FormulaR1C1 = ""
        MsgBox "Seleccione Un Rango de Edad"
    End If
    End If
End Sub
Private Sub CheckBox2_Click()
Range("D2").Select
'Formula para Seleccionar rango de edad menor de 18
    If CheckBox2 Then
        edad = "'" & "-18"
        ActiveCell.FormulaR1C1 = edad
    Else
    If CheckBox1 = "" And CheckBox2 = "" Then
        ActiveCell.FormulaR1C1 = ""
        MsgBox "Seleccione Un Rango de Edad"
    End If
    End If
End Sub
Private Sub ComboBox1_Change()
'Selecciona Localizacion o Donde Vive
Range("E2").Select
ActiveCell.FormulaR1C1 = ComboBox1.Value
End Sub
Private Sub CommandButton1_Click()
'Boton de Guardar/Aceptar
'Captura los datos del formulario y los pasa a la base de datos de excel
If CheckBox1 = True And CheckBox2 = True Then
     MsgBox "solo puede elegir una opción"
        CheckBox1 = False
        CheckBox2 = False
        Exit Sub
    Else
    If CheckBox1 = False And CheckBox2 = False Then
        MsgBox "Elige una edad"
        CheckBox1 = False
        CheckBox2 = False
        Exit Sub
    Else
    If ComboBox1.Value = 0 Or ComboBox1.Value = "" Then
        MsgBox "Elija Su Provincia"
        ComboBox1 = ""
        Exit Sub
    Else
    If ListBox1.Text = "" Then
    MsgBox "Seleccione Su Tipo De Sangre"
    ListBox1 = ""
    Exit Sub
    End If
    End If
    End If
    End If
Selection.EntireRow.Insert
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
Private Sub CommandButton2_Click()
'Boton para Cerrar el Formulario
Unload Me
End Sub
Private Sub CommandButton3_Click()
'Boton para limpiar todos los datos
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
Private Sub CommandButton4_Click()
'Aqui Va El Codigo del boton buscar
'De ser Necesario puedo ingresar un boton Cambiar y conservar Este como Boton Buscar
End Sub
Private Sub ListBox1_Click()
'La lista de tipos de sangre
Range("F2").Select
ActiveCell.FormulaR1C1 = ListBox1.Text
End Sub
Private Sub OptionButton1_Click()
'Opcion para seleccionar Sexo Hombre
If OptionButton1.Value = True Then
Range("C2").Select
ActiveCell.Value = OptionButton1.Caption
End If
If OptionButton1.Value = False Then
MsgBox "Seleccione Una Casilla"
Else
If OptionButton1.Value = False And OptionButton2.Value = False And Len(TextBox1.Text) = 0 Then
MsgBox "Seleccione Una Casilla"
End If
End If
End Sub
Private Sub OptionButton2_Click()
'Opcion Para elegir Sexo mujer
If OptionButton2.Value = True Then
Range("C2").Select
ActiveCell.Value = OptionButton2.Caption
End If
If OptionButton2.Value = False Then
MsgBox "Seleccione Una Casilla"
Else
If OptionButton2.Value = False And OptionButton1.Value = False And Len(TextBox1.Text) = 0 Then
MsgBox "Seleccione Una Casilla"
End If
End If
End Sub
Private Sub TextBox1_Change()
'Nombre
Range("A2").Select
ActiveCell.FormulaR1C1 = TextBox1
End Sub
Private Sub TextBox2_Change()
'Apellido
Range("B2").Select
ActiveCell.FormulaR1C1 = TextBox2
End Sub
Private Sub UserForm_Activate()
'Tipo de Sangre
ListBox1.AddItem ""
End Sub
Private Sub UserForm_Initialize()
'Estas Son Las localidades
ComboBox1.AddItem ""
End Sub

Cualquier ayuda seria muy agradecida.

2 Respuestas

Respuesta
1

Lo que dices que necesitas, yo lo he hecho muchas veces, pero sabes, que esto es como los partidos de futbol, cada uno es distinto. Tal y como te dice Adriel, si me envías el archivo creo que te podría ayudar y me explicas bien la necesidad. Por ejemplo no entiendo bien lo que dices de ver si existen previos. No sé si con eso último lo que quieres decir es validar que no se dupliquen datos. Esto se puede controlar desde la entrada. Si quieres me envías el archivo y con gusto trataré de ayudarte. Mi correo, [email protected]  buen día.

Ya Te envíe un correo. Desde protonmail

Por correo te estoy enviando el archivo con los procedimiendos adicionales que se requerían. Espero haberte podido ayudar. Yo lo probé y todo me funciona como lo habías solicitado. Voy a colocar aquí mis recomendaciones y el código, por si a otra persona le puede servir.

-Cuando colocas el botón para buscar y reemplazar, no se puede hacer en un sólo botón, adicionalmente tienes que destinar una caja para que el usuario pueda ingresar lo que se va a buscar.

-Es muy recomendable nombrar los objetos. Es decir, en vez de combotext1 colocar por ejemplo Nombre y en vez de combotext2 colocar Apellido. Y así todos los demás objetos. Esto facilita el seguimiento y el control.

-Para estructurar la búsqueda se requieren nociones de programación que seguro irás adquiriendo con la práctica. Por ejemplo coloco un SW (switche) para controlar si estoy ingresando un dato nuevo o si estoy es consultando. Por esta razón es que tu opción de guardar, que en tu ejercicio la llamas CommandButton1_Click() (por eso es recomendable dar nombres fáciles de ubicar), yo la divido en dos opciones, una para cuando es nuevo y otra para cuando es consulta.

-Esto también porque al nombre nuevo hay que validar que no esté repetido(según tu solicitud) y el buscado no, porque ya está. Aunque también podría ser que se cambie el nombre y podría tener que validarse. Eso ya tu lo consideras y ajustas.

-En la opción buscar, le coloco la opción de validar y buscar, si lo digitado es nombre o apellido, ahí debes revisar para que aprendas cómo se manejan las variables de columna según el caso, por eso coloco dos opciones de traer los datos, una cuando lo que se digitó es el nombre y otra para apellido.

-En la búsqueda también incluí un control de error para que aprendas a manejar cómo se controlan los errores de búsqueda.

-Incluyo una opción de regrabar que es para cuando se va a guardar la información consultada y modificada

-Incluyo la opción valida, para verificar que no hayan duplicados. Tiene if anidado porque estamos validando tanto nombre como apellidos.

-Incluí por último una rutina para que cuando se cierre el formulario y no se haga nada con la consulta, borre lo que se estaba consultando. Aquí se pueden hacer muchas cosas según lo que se quiera, para controlar el cierre dando click en la X cuando el usuario lo haga.

Ya lo que queda es le hagas los ajustes según tu necesidad o gusto.

Estas son las macros nuevas

Private Sub CommandButton1_Click()

If sw = 0 Then
grabado
Else
grabado
regrabar
End If
End Sub
Sub grabado()

If sw = 0 Then
VALIDA
End If

If CheckBox1 = True And CheckBox2 = True Then
MsgBox "solo puede elegir una opción"
CheckBox1 = False
CheckBox2 = False
Exit Sub
Else
If CheckBox1 = False And CheckBox2 = False Then
MsgBox "Elige una edad"
CheckBox1 = False
CheckBox2 = False
Exit Sub
Else
If ComboBox1.Value = 0 Or ComboBox1.Value = "" Then
MsgBox "Elija Su Provincia"
ComboBox1 = ""
Exit Sub
Else
If ListBox1.Text = "" Then
MsgBox "Seleccione Su Tipo De Sangre"
ListBox1 = ""
Exit Sub
End If
End If
End If
End If
Selection.EntireRow.Insert
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""

End Sub

Private Sub BUSCAR_Click()

BORRA_CAMPOS
sw = 1
Sheets("Hoja1").Select
Range("a2").Select

If BUSCADO <> "" Then
On Error GoTo ControldeError

Cells.Find(What:=BUSCADO, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
COL = ActiveCell.Column
If COL = 1 Then
TRAER_DATOS1
Else
If COL = 2 Then
TRAER_DATOS2
End If
End If
Exit Sub

ControldeError:
If Err.Number = 91 Then
MsgBox ("La información ingresada no figura registrada en la base de datos, por favor verifique lo digitado")
BUSCADO = Empty
BORRA_CAMPOS
End If
End If

End Sub

Private Sub TRAER_DATOS1()
fila = ActiveCell.Row
COL = ActiveCell.Column

TextBox1 = Cells(fila, COL)

TextBox2 = Cells(fila, COL + 1)
If Cells(fila, COL + 3) = 18 Then
CheckBox1 = True
Else
If Cells(fila, COL + 3) = 18 Then
CheckBox2 = True
End If
End If
ComboBox1.Value = Cells(fila, COL + 4)
If Cells(fila, COL + 2).Value = "Mujer" Then
OptionButton2.Value = True
Else
If Cells(fila, COL + 2).Value = "Hombre" Then
OptionButton1.Value = True
End If
End If
ListBox1.Text = Cells(fila, COL + 5)

BUSCADO = Empty
Range("a2").Select
End Sub
Private Sub TRAER_DATOS2()
fila = ActiveCell.Row
COL = ActiveCell.Column

TextBox1 = Cells(fila, COL - 1)

TextBox2 = Cells(fila, COL)

If Cells(fila, COL + 2) = 18 Then
CheckBox1 = True
Else
If Cells(fila, COL + 2) = 18 Then
CheckBox2 = True
End If
End If
ComboBox1.Value = Cells(fila, COL + 3)
If Cells(fila, COL + 1).Value = "Mujer" Then
OptionButton2.Value = True
Else
If Cells(fila, COL + 1).Value = "Hombre" Then
OptionButton1.Value = True
End If
End If
ListBox1.Text = Cells(fila, COL + 4)
sw = 1

BUSCADO = Empty
Range("a2").Select
End Sub

Sub BORRA_CAMPOS()
sw = 0
TextBox1 = Empty
TextBox2 = Empty
ComboBox1 = Empty
OptionButton1 = False
OptionButton2 = False
CheckBox1 = 0
CheckBox2 = 0
Range("A2:F2").Select
Selection.ClearContents
Range("A2").Select
End Sub

Sub regrabar()

Range("A3:F3").Select
Selection.Copy
Cells(fila + 1, 1).Select
ActiveSheet.Paste
Range("A4:F8000").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-126
Range("A3").Select
ActiveSheet.Paste
BUSCADO = Empty
Range("A2").Select
sw = 0
End Sub

Private Sub VALIDA()
Dim dato1, dato2, revisa1, revisa2 As Integer

dato1 = TextBox1.Value
dato2 = TextBox2.Value

revisa1 = Application.WorksheetFunction.CountIf(Sheets("hoja1").Columns(1), dato1)
revisa2 = Application.WorksheetFunction.CountIf(Sheets("hoja1").Columns(2), dato2)
If revisa1 > 1 Then
If revisa2 > 1 Then
MsgBox "Ese nombre ya existe, no se permiten duplicados. Si lo que desea es modificar vaya a la opción Buscar"
Range("A2:F2").Select
Selection.ClearContents
Else
MsgBox "Hay un nombre o apellido repetido pero Puede continuar"

Exit Sub
End If
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Range("A2:F2").Select
Selection.ClearContents
Range("A2").Select
End Sub

Respuesta
1

[Hola 

Envíame tu archivo y me explicas con un ejemplo. [email protected]

[Hola 

Te envié el archivo

Macro con los nuevos ajustes.

Valora la respuesta para finalizar saludos!

Private Sub CommandButton1_Click()
'
'**Por Adriel Ortiz
'
Set h = Sheets("Hoja1")
    If CheckBox1 = True And CheckBox2 = True Then
         MsgBox "solo puede elegir una opción"
            CheckBox1 = False
            CheckBox2 = False
            Exit Sub
    End If
    If CheckBox1 = False And CheckBox2 = False Then
        MsgBox "Elige una edad"
        CheckBox1 = False
        CheckBox2 = False
        Exit Sub
    End If
    If ComboBox1.Value = 0 Or ComboBox1.Value = "" Then
        MsgBox "Elija Su Provincia"
        ComboBox1 = ""
        Exit Sub
    End If
    If ListBox1.ListIndex = -1 Then
    MsgBox "Seleccione Su Tipo De Sangre"
        Exit Sub
    End If
    '
    uf = h.Range("A" & Rows.Count).End(xlUp).Row
    u = h.Range("A" & Rows.Count).End(xlUp).Row + 1
    '
    num = h.Cells(uf, "A")
    If num = "" Then
        TextBox1 = 1
    Else
        TextBox1 = num + 1
    End If
    h.Cells(u, "A") = Val(TextBox1)
    '
    h.Cells(u, "B") = TextBox2
    h.Cells(u, "C") = TextBox3
    '
    If OptionButton1 Then
        sexo = "Hombre"
    End If
    '
    If OptionButton2 Then
        sexo = "Mujer"
    End If
    h.Cells(u, "D") = sexo
    '**********************************
    If CheckBox1 Then
        edad = "'" & "+18"
    End If
    '
    If CheckBox1 Then
        edad = "'" & "-18"
    End If
    h.Cells(u, "E") = edad
    '
    h.Cells(u, "F") = ComboBox1
    h.Cells(u, "G") = ListBox1.List(ListBox1.ListIndex, 0)
    Call limpiar
End Sub
'
Private Sub CommandButton2_Click()
Unload Me
End Sub
'
Private Sub CommandButton3_Click()
TextBox1 = Empty
TextBox2 = Empty
TextBox1.SetFocus
CheckBox1 = 0
CheckBox2 = 0
OptionButton1 = False
OptionButton2 = False
ComboBox1 = ""
ListBox1 = ""
End Sub
'
Private Sub CommandButton4_Click()
'Aqui Va El Codigo del boton buscar
'De ser Necesario puedo ingresar un boton Cambiar y conservar Este como Boton Buscar
Set h5 = Sheets("Hoja1")
If Txtbuscar.Text <> "" Then
Txtbuscar.Text = UCase(Txtbuscar.Text)
    ListBox2.Clear
    For i = 2 To h5.Range("A" & Rows.Count).End(xlUp).Row
        cad = h5.Cells(i, "B") & UCase(h5.Cells(i, "B"))
        If cad Like "*" & UCase(Txtbuscar) & "*" Then
            With ListBox2
                . AddItem h5.Cells(i, "A")
                . List(.ListCount - 1, 1) = h5.Cells(i, "B")
                . List(.ListCount - 1, 2) = h5.Cells(i, "C")
                . List(.ListCount - 1, 3) = h5.Cells(i, "D")
                . List(.ListCount - 1, 4) = h5.Cells(i, "E")
                . List(.ListCount - 1, 5) = h5.Cells(i, "F")
                . List(.ListCount - 1, 6) = h5.Cells(i, "G")
            End With
        End If
    Next
Else
Txtbuscar.SetFocus
End If
End Sub
'
Private Sub CommandButton5_Click()
Set h1 = Sheets("Hoja1")
'
    If ListBox2.ListIndex = -1 Then
        MsgBox "Debe seleccionar un registro"
        Exit Sub
    End If
    '
    cod = ListBox2.List(ListBox2.ListIndex, 0)
    Set r = h1.Columns("A")
    Set b = r.Find(cod, lookat:=xlWhole)
    If Not b Is Nothing Then
        h1.Cells(b.Row, "B") = TextBox2
        h1.Cells(b.Row, "C") = TextBox3
        '
        If OptionButton1 Then
            sexo = "Hombre"
        End If
        '
        If OptionButton2 Then
            sexo = "Mujer"
        End If
        h1.Cells(b.Row, "D") = sexo
        '**********************************
        If CheckBox1 Then
            edad = "'" & "+18"
        End If
        '
        If CheckBox1 Then
            edad = "'" & "-18"
        End If
        h1.Cells(b.Row, "E") = edad
        '
        h1.Cells(b.Row, "F") = ComboBox1
        h1.Cells(b.Row, "G") = ListBox1.List(ListBox1.ListIndex, 0)
    End If
    MsgBox "Datos Actualizados con éxito"
    Txtbuscar = ""
    ListBox2.Clear
    Call limpiar
End Sub
'
Private Sub ListBox2_Click()
    TextBox1 = ListBox2.List(ListBox2.ListIndex, 0)
    TextBox2 = ListBox2.List(ListBox2.ListIndex, 1)
    TextBox3 = ListBox2.List(ListBox2.ListIndex, 2)
    sexo = ListBox2.List(ListBox2.ListIndex, 3)
    If sexo = "Hombre" Then
        OptionButton1 = True
        Else
        OptionButton1 = False
    End If
        '
    If sexo = "Mujer" Then
        OptionButton2 = True
        Else
        OptionButton2 = False
    End If
    '
    dato = ListBox2.List(ListBox2.ListIndex, 4)
    If dato = "+18" Then
        CheckBox1 = True
        Else
        CheckBox1 = False
    End If
        '
    If dato = "-18" Then
        CheckBox2 = True
        Else
        CheckBox2 = False
    End If
    ComboBox1 = ListBox2.List(ListBox2.ListIndex, 5)
    ListBox1 = ListBox2.List(ListBox2.ListIndex, 6)
End Sub
'
Sub limpiar()
    TextBox1 = Empty
    TextBox2 = Empty
    TextBox3 = Empty
    TextBox2.SetFocus
    CheckBox1 = 0
    CheckBox2 = 0
    OptionButton1 = False
    OptionButton2 = False
    ComboBox1 = ""
    ListBox1 = ""
End Sub
'
Private Sub UserForm_Activate()
ListBox1.AddItem ""
ListBox1.AddItem "O+"
ListBox1.AddItem "O-"
ListBox1.AddItem "A+"
ListBox1.AddItem "A-"
ListBox1.AddItem "B+"
ListBox1.AddItem "B-"
ListBox1.AddItem "AB+"
ListBox1.AddItem "AB-"
End Sub
'
Private Sub UserForm_Initialize()
ComboBox1. AddItem ""
ComboBox1. AddItem "Bocas Del Toro"
ComboBox1. AddItem "Cocle"
ComboBox1. AddItem "Colon"
ComboBox1. AddItem "Chiriqui"
ComboBox1. AddItem "Darien"
ComboBox1. AddItem "Herrera"
ComboBox1. AddItem "Los santos"
ComboBox1. AddItem "Panama"
ComboBox1. AddItem "Veraguas"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

¿Cómo resolver num a letras en excel?

En un libro excel habilitado para macros al convertir números a letras, en lugar de aparecer el resultado esperado aparece el mensaje # ¿NOMBRE?.
1 respuesta

´No sé que fórmulas usar para resolverme el problema

La imagen no me la sube y tampoco veo como se sube un fichero, os intentaré explicar lo mejor que pueda mi problema. En una hoja Excel tengo hallados los pagos por formas de pago: SUMAR.SI(D1:D16;"Efectivo";B1:B16), y...
1 respuesta

¿Cómo usar un excel con macros desde varios ordenadores?

A tod@s! Tengo una aplicación en excel para introducir datos y visualizarlos con diferentes formularios creados. Lo que quiero hacer es: 1 Que ese libro este alojado en un sitio común y que lo puedan abrir desde varios ordenadores. 2º Que se pueda...
3 respuestas

Error en macro al ejecutar el botón aceptar

Necesitaría la colaboración para resolver el error que sucede al ejecutar el botón aceptar Set mifila = Hoja2.ListObjects(1).ListRows.Add Lo que yo agregue solamente a la base fue una columna al inicio ("A") anteriormente se llamaba Tabla6 y yo ahora...
1 respuesta

Detectar cambios en tabla dinámica

Tengo una hoja donde se van actualizando datos mediante una tabla dinámica. ¿Cómo detecto cuando se producen cambios (sólo en la parte de la tabla dinámica) para ejecutar otra macro en la misma hoja?
1 respuesta

Macro con combinación de teclas

Acudo aquí buscando ayuda, ¿Cómo crear una macro que genere una combinación de teclas? NO se trata de asignar una macro a una combinación de teclas, es todo lo contrario. El problema radica en que tengo una macro que rellena ciertas celdas con...
1 respuesta

Pasar datos de listbox a hoja con decimales

Como están estimados maestros y maestras, una vez mas solicitando vuestra experta ayuda. Tengo un formulario que busca datos entre 2 fechas desde 2 textbox, carga en listbox lo filtrado, en la columna 2 del listbox carga valores con formato de 2...
1 respuesta

Una macro que de aviso sobre vencimiento de una cedula de identidad

Tengo una hoja de calculo de 6 columnas en donde la columna A es fecha de vencimiento, las columnas B, C, y D son apellidos paterno, Materno u nombres, la columna E es el numero de cedula de identidad Con Formato ##.###.###-# la columna F es lo...
1 respuesta

Error decimales en hoja de excel

Tengo un albarán de varios productos que no vienen desglosado el iva En una hoja Excel introduzco el precio, con la formula sumar el precio lo desgloso en base imponible y el iva paracque me dé el precio del producto pero cuando sumo el total de...
4 respuestas

Filtrar información y luego pasar a otro libro

Tengo una macro que copia y pega del libro llamado Origen y Hoja1, dónde este está cerrado, al libro Destino y Hoja 2 de la siguiente manera: Sub importar() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual...
1 respuesta