Saltar al contenido

Crear un buscador y que devuelva encontrado en formulario


Emasd

Recommended Posts

publicado

Hola a todos!

En esta oportunidad los molesto con un proyecto en el que estoy trabajando en el que necesitaría crear un buscador (A modo de formulario), que al encontrar el "Campo clave" o "Primary Key" me devuelva los demás campos que le corresponden cargado en un Formulario.

Los pasos serían los siguientes:

*Clickea en un botón

*Abre el formulario de búsqueda

*Carga el dato "Clave" y presiona en buscar

*Devuelve todos los datos correspondientes a ese campo "Clave" o informa que no se encontró nada con ese nombre

Ya tengo algo armado, pero realmente lo veo muy primitivo (Y funciona el 50% de las veces) y condicionado a mezclar el modelo de programación con el del negocio.

Por favor, si necesitan que les arme alguna planilla de ejemplo, no duden en pedirmelo.

Saludos.

publicado

Prueba con esto si no es lo que busca sube tu archivo ya que esas son las reglas

Private Sub CommandButton1_Click()

Dim id_nombre, idBuscar As String

Dim fila As Integer

fila = 1

id_nombre = TextBox1

If TextBox1 = "" Then Exit Sub

Do While idBuscar <> id_nombre

fila = fila + 1

idBuscar = Range("A" & fila).Value

If idBuscar = Empty Then

MsgBox "Código no Encontrado"

Exit Do

End If

Loop

TextBox2 = Range("b" & fila).Value

TextBox3 = Range("C" & fila).Value

TextBox4 = Range("D" & fila).Value

End Sub

publicado

Compaq,

Antes que nada, muchas gracias por tu respuesta!

Voy a probar la lógica que sugerís adaptándola al modelo que hice yo. Cualquier cosa te comento como funcionó.

Si alguien mas considera alguna posible solución, les agradezco que me la hagan saber.

Saludos

publicado
Prueba con esto si no es lo que busca sube tu archivo ya que esas son las reglas

Private Sub CommandButton1_Click()

Dim id_nombre, idBuscar As String

Dim fila As Integer

fila = 1

id_nombre = TextBox1

If TextBox1 = "" Then Exit Sub

Do While idBuscar <> id_nombre

fila = fila + 1

idBuscar = Range("A" & fila).Value

If idBuscar = Empty Then

MsgBox "Código no Encontrado"

Exit Do

End If

Loop

TextBox2 = Range("b" & fila).Value

TextBox3 = Range("C" & fila).Value

TextBox4 = Range("D" & fila).Value

End Sub

Compaq, funcionó, muchas gracias!

Un detalle que me olvidé de nombrar es que necesitaría que una vez que me trae los datos al formulario, es que los pueda modificar y al presionar un botón que se puedan actualizar todos los campos del registro que me trajo con ese ID.

publicado

Trata de hacer el formulario para modificar si tenes problemas te subo el archivo de buscar,ingresar y modificar datos.

Private Sub Label4_Click()

End Sub

Private Sub LOGOFALSO_Click()

End Sub


Private Sub NOMBRE_Change()

End Sub

Private Sub REGISTRAR_Click()

If TIPOSDEEMPRESAS = "" Then TIPOSDEEMPRESAS.SetFocus: tbcedulachofer = "": tbrepresentante = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": NOMBRE = "": Exit Sub

If Len(NOMBRE) < Len("00") Then TIPOSDEEMPRESAS = "": tbcedulachofer = "": tbrepresentante = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": NOMBRE = "": LOGO.Visible = True: LOGOFALSO.Visible = False: Exit Sub

If NOMBRE = "" Then NOMBRE.SetFocus: Exit Sub

RPTA = MsgBox("DESEA MODIFICAR LOS DATOS?", vbYesNo + vbQuestion)
If RPTA = vbNo Then TIPOSDEEMPRESAS = "": tbcedulachofer = "": tbrepresentante = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": Exit Sub



Sheets("INGRESO").Select 'MODIFICA EL NOMBRE DE LA EMPRESA EN LA HOJA : INGRESO
Range("INGRESO").Select
ActiveCell.Offset(1, 0).Select

While ActiveCell <> Empty

If ActiveCell = TIPOSDEEMPRESAS Then ActiveCell = NOMBRE
If ActiveCell = "" Then GoTo CONTINUAR2
ActiveCell.Offset(1, 0).Select
ActiveCell.Select

Wend

CONTINUAR2:
Z = tbnombre
y = tbplaca1
x = tbplaca2
W = tbzona
U = tbcomprador
T = tbchofer
S = tbayudante
R = tbproducto
Q = NOMBRE
A = tbcedulachofer
B = tbrepresentante

Sheets("PROVEEDORES").Select 'AQUI BUSCA LA EMPRESA SELECCIONADA Y SI NO ESTA REGISTRADA FIN DE LA EJECUCION
Range("EMPRESA").Select
ActiveCell.Offset(1, 0).Select

While ActiveCell <> Empty

If ActiveCell = TIPOSDEEMPRESAS Then GoTo VAMONOS
If ActiveCell = "" Then GoTo CONTINUAR3
ActiveCell.Offset(1, 0).Select
ActiveCell.Select

Wend

VAMONOS:

ActiveCell = Q
ActiveCell.Offset(0, 1) = Z
ActiveCell.Offset(0, 2) = A
ActiveCell.Offset(0, 3) = T
ActiveCell.Offset(0, 4) = S
ActiveCell.Offset(0, 5) = B
ActiveCell.Offset(0, 6) = y
ActiveCell.Offset(0, 7) = x
ActiveCell.Offset(0, 8) = W
ActiveCell.Offset(0, 9) = U
ActiveCell.Offset(0, 10) = R

CONTINUAR3:

NOMBRE = ""
tbnombre = ""
tbrepresentante = ""
tbcedulachofer = ""
tbplaca1 = ""
tbplaca2 = ""
tbzona = ""
tbcomprador = ""
tbchofer = ""
tbayudante = ""
tbproducto = ""
tbrepresentante = ""

End Sub



Private Sub SALIR_Click()

Sheets("INGRESO").Visible = False
Sheets("PROVEEDORES").Visible = True

Unload Me
End Sub


Private Sub tbayudante_Change()


End Sub

Private Sub tbcedulachofer_Change()



End Sub

Private Sub tbchofer_Change()



End Sub

Private Sub tbcomprador_Change()

End Sub

Private Sub tbnombre_Change()

If Val(tbnombre) <> Text Then tbnombre = "": Exit Sub
If tbnombre = "" Then Exit Sub

End Sub

Private Sub tbplaca1_Change()



End Sub

Private Sub tbplaca2_Change()



End Sub



Private Sub tbproducto_Change()

End Sub

Private Sub tbrepresentante_Change()

End Sub

Private Sub tbzona_Change()

End Sub



Private Sub TIPOSDEEMPRESAS_Change()

Beep
MSG = "MODIFICAR DATOS DE PROVEEDOR" & vbNewLine & "ASEGURESE DE COMFIRMAR CODIGO DE PROVEEDOR" & vbNewLine & "EN LA CASILLA DE COMFIRMACION"


LOGO.Picture = LoadPicture("") 'AQUI PRIMERO BORRA TODO Y ESTA LISTO PARA COMENZAR A BUSCAR LA EMPRESA SELECCIONADA
LOGO.Visible = True
LOGOFALSO.Visible = False
tbnombre = ""
tbrepresentante = ""
tbcedulachofer = ""
tbplaca1 = ""
tbplaca2 = ""
tbzona = ""
tbcomprador = ""
tbchofer = ""
tbayudante = ""
tbproducto = ""
tbrepresentante = ""

Sheets("PROVEEDORES").Select 'AQUI BUSCA LA EMPRESA SELECCIONADA Y SI NO ESTA REGISTRADA FIN DE LA EJECUCION
Range("EMPRESA").Select
ActiveCell.Offset(1, 0).Select


While ActiveCell <> TIPOSDEEMPRESAS

If ActiveCell = "" Then TIPOSDEEMPRESAS = "": LOGO.Visible = True: LOGOFALSO.Visible = False: Exit Sub

ActiveCell.Offset(1, 0).Select

Wend

'AQUI EMPIEZA HA BUSCAR LOS DATOS DE LA EMPRESA SELECCIONADA

On Error GoTo SINFOTO
LOGO.Picture = Nothing
If TIPOSDEEMPRESAS = "" Then LOGO.Picture = LoadPicture(""): tbrepresentante = "": tbcedulachofer = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": Exit Sub
If Len(TIPOSDEEMPRESAS) < Len("00") Then TIPOSDEEMPRESAS = "": LOGO.Visible = True: LOGOFALSO.Visible = False: Exit Sub
Ruta = ActiveWorkbook.Path
If TIPOSDEEMPRESAS = "" Then Foto.Visible = False: Exit Sub

LOGO.Visible = True
LOGO.Picture = LoadPicture(Ruta & "\" & TIPOSDEEMPRESAS & ".jpg"): LOGO.Visible = True: LOGOFALSO.Visible = False
tbnombre = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 2, 0)
tbcedulachofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 3, 0)
tbchofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 4, 0)
tbayudante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 5, 0)
tbrepresentante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 6, 0)
tbplaca1 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 7, 0)
tbplaca2 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 8, 0)
tbzona = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 9, 0)
tbcomprador = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 10, 0)
tbproducto = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 11, 0)

GoTo SEGUIMOS10000

SINFOTO:

LOGO.Visible = False: LOGOFALSO.Visible = True

SEGUIMOS10000:

tbnombre = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 2, 0)
tbcedulachofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 3, 0)
tbchofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 4, 0)
tbayudante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 5, 0)
tbrepresentante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 6, 0)
tbplaca1 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 7, 0)
tbplaca2 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 8, 0)
tbzona = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 9, 0)
tbcomprador = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 10, 0)
tbproducto = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 11, 0)

End Sub
Private Sub UserForm_Initialize()
Dim hoja As String

hoja = "PROVEEDORES"
Sheets(hoja).Activate
Sheets(hoja).Unprotect (klavex)


Sheets(hoja).Activate


End Sub

Private Sub UserForm_Terminate()
Dim hoja As String


hoja = "PROVEEDORES"
Sheets(hoja).Activate




Sheets(hoja).Protect (klavex)

Sheets(hoja).Activate
validar = False
End Sub


[/CODE]

publicado
Trata de hacer el formulario para modificar si tenes problemas te subo el archivo de buscar,ingresar y modificar datos.

Private Sub Label4_Click()

End Sub

Private Sub LOGOFALSO_Click()

End Sub


Private Sub NOMBRE_Change()

End Sub

Private Sub REGISTRAR_Click()

If TIPOSDEEMPRESAS = "" Then TIPOSDEEMPRESAS.SetFocus: tbcedulachofer = "": tbrepresentante = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": NOMBRE = "": Exit Sub

If Len(NOMBRE) < Len("00") Then TIPOSDEEMPRESAS = "": tbcedulachofer = "": tbrepresentante = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": NOMBRE = "": LOGO.Visible = True: LOGOFALSO.Visible = False: Exit Sub

If NOMBRE = "" Then NOMBRE.SetFocus: Exit Sub

RPTA = MsgBox("DESEA MODIFICAR LOS DATOS?", vbYesNo + vbQuestion)
If RPTA = vbNo Then TIPOSDEEMPRESAS = "": tbcedulachofer = "": tbrepresentante = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": Exit Sub



Sheets("INGRESO").Select 'MODIFICA EL NOMBRE DE LA EMPRESA EN LA HOJA : INGRESO
Range("INGRESO").Select
ActiveCell.Offset(1, 0).Select

While ActiveCell <> Empty

If ActiveCell = TIPOSDEEMPRESAS Then ActiveCell = NOMBRE
If ActiveCell = "" Then GoTo CONTINUAR2
ActiveCell.Offset(1, 0).Select
ActiveCell.Select

Wend

CONTINUAR2:
Z = tbnombre
y = tbplaca1
x = tbplaca2
W = tbzona
U = tbcomprador
T = tbchofer
S = tbayudante
R = tbproducto
Q = NOMBRE
A = tbcedulachofer
B = tbrepresentante

Sheets("PROVEEDORES").Select 'AQUI BUSCA LA EMPRESA SELECCIONADA Y SI NO ESTA REGISTRADA FIN DE LA EJECUCION
Range("EMPRESA").Select
ActiveCell.Offset(1, 0).Select

While ActiveCell <> Empty

If ActiveCell = TIPOSDEEMPRESAS Then GoTo VAMONOS
If ActiveCell = "" Then GoTo CONTINUAR3
ActiveCell.Offset(1, 0).Select
ActiveCell.Select

Wend

VAMONOS:

ActiveCell = Q
ActiveCell.Offset(0, 1) = Z
ActiveCell.Offset(0, 2) = A
ActiveCell.Offset(0, 3) = T
ActiveCell.Offset(0, 4) = S
ActiveCell.Offset(0, 5) = B
ActiveCell.Offset(0, 6) = y
ActiveCell.Offset(0, 7) = x
ActiveCell.Offset(0, 8) = W
ActiveCell.Offset(0, 9) = U
ActiveCell.Offset(0, 10) = R

CONTINUAR3:

NOMBRE = ""
tbnombre = ""
tbrepresentante = ""
tbcedulachofer = ""
tbplaca1 = ""
tbplaca2 = ""
tbzona = ""
tbcomprador = ""
tbchofer = ""
tbayudante = ""
tbproducto = ""
tbrepresentante = ""

End Sub



Private Sub SALIR_Click()

Sheets("INGRESO").Visible = False
Sheets("PROVEEDORES").Visible = True

Unload Me
End Sub


Private Sub tbayudante_Change()


End Sub

Private Sub tbcedulachofer_Change()



End Sub

Private Sub tbchofer_Change()



End Sub

Private Sub tbcomprador_Change()

End Sub

Private Sub tbnombre_Change()

If Val(tbnombre) <> Text Then tbnombre = "": Exit Sub
If tbnombre = "" Then Exit Sub

End Sub

Private Sub tbplaca1_Change()



End Sub

Private Sub tbplaca2_Change()



End Sub



Private Sub tbproducto_Change()

End Sub

Private Sub tbrepresentante_Change()

End Sub

Private Sub tbzona_Change()

End Sub



Private Sub TIPOSDEEMPRESAS_Change()

Beep
MSG = "MODIFICAR DATOS DE PROVEEDOR" & vbNewLine & "ASEGURESE DE COMFIRMAR CODIGO DE PROVEEDOR" & vbNewLine & "EN LA CASILLA DE COMFIRMACION"


LOGO.Picture = LoadPicture("") 'AQUI PRIMERO BORRA TODO Y ESTA LISTO PARA COMENZAR A BUSCAR LA EMPRESA SELECCIONADA
LOGO.Visible = True
LOGOFALSO.Visible = False
tbnombre = ""
tbrepresentante = ""
tbcedulachofer = ""
tbplaca1 = ""
tbplaca2 = ""
tbzona = ""
tbcomprador = ""
tbchofer = ""
tbayudante = ""
tbproducto = ""
tbrepresentante = ""

Sheets("PROVEEDORES").Select 'AQUI BUSCA LA EMPRESA SELECCIONADA Y SI NO ESTA REGISTRADA FIN DE LA EJECUCION
Range("EMPRESA").Select
ActiveCell.Offset(1, 0).Select


While ActiveCell <> TIPOSDEEMPRESAS

If ActiveCell = "" Then TIPOSDEEMPRESAS = "": LOGO.Visible = True: LOGOFALSO.Visible = False: Exit Sub

ActiveCell.Offset(1, 0).Select

Wend

'AQUI EMPIEZA HA BUSCAR LOS DATOS DE LA EMPRESA SELECCIONADA

On Error GoTo SINFOTO
LOGO.Picture = Nothing
If TIPOSDEEMPRESAS = "" Then LOGO.Picture = LoadPicture(""): tbrepresentante = "": tbcedulachofer = "": tbnombre = "": tbplaca1 = "": tbplaca2 = "": tbzona = "": tbplaca3 = "": tbcomprador = "": tbchofer = "": tbayudante = "": tbproducto = "": Exit Sub
If Len(TIPOSDEEMPRESAS) < Len("00") Then TIPOSDEEMPRESAS = "": LOGO.Visible = True: LOGOFALSO.Visible = False: Exit Sub
Ruta = ActiveWorkbook.Path
If TIPOSDEEMPRESAS = "" Then Foto.Visible = False: Exit Sub

LOGO.Visible = True
LOGO.Picture = LoadPicture(Ruta & "\" & TIPOSDEEMPRESAS & ".jpg"): LOGO.Visible = True: LOGOFALSO.Visible = False
tbnombre = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 2, 0)
tbcedulachofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 3, 0)
tbchofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 4, 0)
tbayudante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 5, 0)
tbrepresentante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 6, 0)
tbplaca1 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 7, 0)
tbplaca2 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 8, 0)
tbzona = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 9, 0)
tbcomprador = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 10, 0)
tbproducto = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 11, 0)

GoTo SEGUIMOS10000

SINFOTO:

LOGO.Visible = False: LOGOFALSO.Visible = True

SEGUIMOS10000:

tbnombre = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 2, 0)
tbcedulachofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 3, 0)
tbchofer = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 4, 0)
tbayudante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 5, 0)
tbrepresentante = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 6, 0)
tbplaca1 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 7, 0)
tbplaca2 = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 8, 0)
tbzona = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 9, 0)
tbcomprador = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 10, 0)
tbproducto = Application.WorksheetFunction.VLookup(TIPOSDEEMPRESAS, Range("TABLA2"), 11, 0)

End Sub
Private Sub UserForm_Initialize()
Dim hoja As String

hoja = "PROVEEDORES"
Sheets(hoja).Activate
Sheets(hoja).Unprotect (klavex)


Sheets(hoja).Activate


End Sub

Private Sub UserForm_Terminate()
Dim hoja As String


hoja = "PROVEEDORES"
Sheets(hoja).Activate




Sheets(hoja).Protect (klavex)

Sheets(hoja).Activate
validar = False
End Sub


[/CODE]

Hola Tan178, primero que nada, muchas gracias.

Realmente estuve tratando de entender y adaptar el código que vos me pasaste según mis necesidades, pero no puedo entender donde se hacen los pasos que necesitaría. Por ahora estoy estancado en la parte de actualizar los datos después que los trae al formulario.

Decime por favor, si te serviría que arme un archivo de ejemplo con el estilo que estoy usando yo a ver si así lo puedo entender mejor.

Saludos, y gracias nuevamente.

publicado

Hola en un formulario crea 4 textbox y 2 botones y colocas este código:


Public x As String
Private Sub CommandButton1_Click()
Dim busq As Range
On Error Resume Next
Set busq = Cells.Find(TextBox1, lookat:=xlWhole)
If busq Is Nothing Then MsgBox "Valor no encontrado": Exit Sub
x = busq.Row
TextBox2 = Cells(x, "B")
TextBox3 = Cells(x, "C")
TextBox4 = Cells(x, "D")
End Sub
Private Sub CommandButton2_Click()
If x = "" Then x = Range("A" & Rows.Count).End(xlUp).Row + 1
Cells(x, "A") = TextBox1
Cells(x, "B") = TextBox2
Cells(x, "C") = TextBox3
Cells(x, "D") = TextBox4
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
x = ""
End Sub
[/CODE]

Donde el botón 1 sera con el que buscaras el valor que contenga el textbox1 y el botón 2 modificara los valores o también los agregara.

No esperes a que te pidamos un archivo ejemplo, siempre debes subirlo ya que de esta forma siempre recibirás respuestas genéricas y pueden que no sepas como adaptarlas a tu trabajo.

Salu2

publicado
Hola Tan178, primero que nada, muchas gracias.

Realmente estuve tratando de entender y adaptar el código que vos me pasaste según mis necesidades, pero no puedo entender donde se hacen los pasos que necesitaría. Por ahora estoy estancado en la parte de actualizar los datos después que los trae al formulario.

Decime por favor, si te serviría que arme un archivo de ejemplo con el estilo que estoy usando yo a ver si así lo puedo entender mejor.

Saludos, y gracias nuevamente.

ok pasame un archivo con los datos que vas a utilizar para poder establecer los rangos en el formulario.

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29

    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Que tal nuevamente,  adjunto una solución alternativa: =MAX(A:.A)-BYROW(F4:.AK20,LAMBDA(r,BUSCAR(2,1/(r=0),F3:.AK3))) Cabe mencionar que esta solución requiere funciones nuevas como RECORTAR.RANGO. CONTADOR FINAL (Solucion).xlsb
    • Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • 'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.