Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Error con codigo

Bcordero

Recommended Posts

Bcordero Novato

Bcordero

publicado
publicado

Buenas tarde tratando de acoplar a un archivo de auto filtro me quedo con la sorpresa que me manda un error al momento de ejecutarlo revisándolo y viendo que el código es el correcto no logro encontrar cual es el error

Public Ruc As Double

Public Nomclien As String

Public Articulo As Double

Public Descripcion As String

Public Unidad As String

Public Cantidad As Double

Public Familia As String

Public Documento As String

Public fecha As Date

Public fecha2 As Date

Public CodFam As Integer


Private Sub DTPicker1_Change()

    If Not IsNull(DTPicker1.Value) Then _

    fecha = VBA.Format(DTPicker1.Value, "mm/dd/yyyy")

    super_turbofiltro_GP

End Sub


Private Sub DTPicker2_Change()

    If Not IsNull(DTPicker2.Value) Then _

    fecha2 = VBA.Format(DTPicker2.Value, "mm/dd/yyyy")

    super_turbofiltro_GP

End Sub


Private Sub Label16_Click()


End Sub


Private Sub Rucgp_Change()

    Ruc = VBA.Val(Me.Rucgp.Value)

    'consecutivo = Me.Consecutivogp.Text

    super_turbofiltro_GP

End Sub


Private Sub Nomcliengp_Change()

    Nomclien = Me.Nomcliengp.Text & IIf(Me.Nomcliengp.Text = "", "", "*")

    super_turbofiltro_GP

End Sub


Private Sub Articulogp_Change()

    Articulo = VBA.Val(Me.Articulogp.Value)

    super_turbofiltro_GP

End Sub


Private Sub Descripciongp_Change()

    Descripcion = Me.Descripciongp.Text & IIf(Me.Descripciongp.Text = "", "", "*")

    super_turbofiltro_GP

End Sub


Private Sub Unidadgp_Change()

    Unidad = Me.Unidadgp.Text & IIf(Me.Unidadgp.Text = "", "", "*")

    super_turbofiltro_GP

End Sub

Private Sub Familiagp_Change()

    Familia = Me.Familiagp.Text & IIf(Me.Familiagp.Text = "", "", "*")

    super_turbofiltro_GP

End Sub

Private Sub Documentogp_Change()

    Documento = Me.Documentogp.Text & IIf(Me.Documentogp.Text = "", "", "*")

    super_turbofiltro_GP

End Sub


Private Sub CodFamgp_Change()

    CodFam = VBA.Val(Me.CodFamgp.Value)

    super_turbofiltro_GP

End Sub

Private Sub Cantidadgp_Change()

    Cantidad = VBA.Val(Me.Cantidadgp.Value)

    super_turbofiltro_GP

End Sub


Private Sub ComboBox1_Change()

    super_turbofiltro_GP

End Sub


Private Sub filtrargp()

Application.ScreenUpdating = False

    Dim uf As Integer

    Sheets("LISTBOX").Range("A1").CurrentRegion.Delete xlShiftUp

    With Sheets(Me.ComboBox1.Text)

    uf = .Range("A" & Rows.Count).End(xlUp).Row

    With .Range("A1:J" & uf)

    If Ruc Or fecha Or fecha2 Or Nomclien <> "" Or Articulo _

    Or Descripcion <> "" Or Unidad <> "" Or Familia <> "" Or Documento <> "" Or CodFam Then

        If Ruc Then .AutoFilter Field:=1, Criteria1:=Ruc

        If fecha And fecha2 Then .AutoFilter _

        Field:=2, Criteria1:=">=" & fecha, Operator:=xlAnd, Criteria2:="<=" & fecha2

        If Nomclien <> "" Then .AutoFilter Field:=3, Criteria1:=Nomclien

        If Articulo Then .AutoFilter Field:=4, Criteria1:=Articulo

        If Descripcion <> "" Then .AutoFilter Field:=5, Criteria1:=Descripcion

        If Unidad <> "" Then .AutoFilter Field:=6, Criteria1:=Unidad

        If Cantidad Then .AutoFilter Field:=7, Criteria1:=Cantidad

        If Familia Then .AutoFilter Field:=8, Criteria1:=Familia 'error salta aqui

        If Documento Then .AutoFilter Field:=9, Criteria1:=Documento

        If CodFam Then .AutoFilter Field:=10, Criteria1:=CodFam

        .Offset(1).Copy Sheets("LISTBOX").Range("A1")

    Else

        Sheets("LISTBOX").Range("A1").CurrentRegion.Delete xlShiftUp

        Me.ListBox1 = ""

    End If

    End With

    If .AutoFilterMode Then .AutoFilterMode = False

    End With

Application.ScreenUpdating = True

End Sub


Private Sub UserForm_Activate()

    Me.Rucgp.SetFocus

End Sub


Private Sub UserForm_Initialize()

    For Each hoj In Worksheets

        If hoj.Name <> "Menu" And hoj.Name <> "LISTBOX" Then _

        Me.ComboBox1.AddItem hoj.Name

    Next

    Me.ComboBox1 = Me.ComboBox1.List(0, 0)

    Me.ListBox1.ColumnWidths = "90pt;135pt;120pt;75pt;57pt;60pt;60pt;60pt;60pt"

    Me.DTPicker1.Value = Date: Me.DTPicker2.Value = Date

    Me.registrogp.Visible = False

End Sub


Private Sub UserForm_Terminate()

Application.ScreenUpdating = False

    Sheets("LISTBOX").Range("A1").CurrentRegion.Delete xlShiftUp

    Me.ListBox1 = ""

Application.ScreenUpdating = True

End Sub


Sub super_turbofiltro_GP()

    Dim uf2 As Integer

    filtrargp

    Me.registrogp.Visible = False

    With Sheets("LISTBOX")

        uf2 = .Range("B" & Rows.Count).End(xlUp).Row

        Me.ListBox1.RowSource = .Name & "!A1:J" & uf2

    End With

End Sub


Private Sub ListBox1_Click()

For i = 0 To 9

With Me.ListBox1

    registro = registro & "  ~  " & .List(.ListIndex, i)

End With

Next

With registrogp

    .Visible = True

    .Caption = VBA.Replace(registro, "~", "", , 1)

End With

End Sub

[/CODE]

pues espero que puedan ayudarme a resolverlo porfavor

gracias

AUTOFILTROS.zip

Archivado

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

Ir al listado de temas

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

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


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de 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
    Un juego del Rabino en Excel
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Oscar_MRF
      Contar días Consecutivos desde el último día.

      Por Oscar_MRF · publicado

      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
    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Adjunto excel CONTADOR FINAL.xlsb
    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      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
    • Tilin2023
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por Tilin2023 · publicado

      @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      '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.