Formulario filtrar datos en listbox me cambia valores al ejecutar los filtros

[jalomiva]

Buenas tardes a los foreros y en especial a los maestros que tanto nos reportan con sus conocimientos a los iniciados, el problema que se me representa con el formulario es que al cargar los datos estos los importa correctamente es a la hora de usar el filtro tanto el Control como la Fecha, la fila de Objetivo% (es numérico) no me respeta los dos decimales sino que este los amplía hasta llegar a 8 decimales he buscado por el foro y no visto nada al respecto, os agradecería cómo solucionar dicho inconveniente Gracias por adelantado .......no puedo adjuntar el archivo me dice que es demasiado grande, adjunto macro por si sirve de algo.

Private Sub CommandButton3_Click()
Dim Columnas As Integer

Columnas = Range("Tabla6").Columns.Count

Private Sub btnSalir_Click()
End
End Sub

Private Sub CommandButton3_Click()

Dim Columnas As Integer

Columnas = Range("Tabla6").Columns.Count

With Me.ListBox1

    .ColumnCount = Columnas
    .ColumnWidths = "55pt;160pt;55pt;55pt;55pt;65pt;65pt;65pt;60pt;50pt;0pt;0pt"
    .ColumnHeads = True
    .RowSource = "Tabla6"

End With

End Sub

Private Sub CommandButton4_Click()
Dim fila As Long, i As Long
fila = Hoja9.Range("B" & Rows.Count).End(xlUp).Row + 1

For i = 0 To ListBox1.ListCount - 1
    
  Hoja9.Cells(fila, 2) = ListBox1.List(i, 0)
  Hoja9.Cells(fila, 3) = ListBox1.List(i, 1)
  Hoja9.Cells(fila, 5) = ListBox1.List(i, 2)
  Hoja9.Cells(fila, 6) = ListBox1.List(i, 3)
  Hoja9.Cells(fila, 7) = ListBox1.List(i, 4)
  Hoja9.Cells(fila, ? = ListBox1.List(i, 5)
  Hoja9.Cells(fila, 9) = ListBox1.List(i, 6)
  Hoja9.Cells(fila, 10) = ListBox1.List(i, 7)
  Hoja9.Cells(fila, 14) = ListBox1.List(i, ?
  
  
  fila = fila + 1
 
Next i
   
End Sub

Private Sub CommandButton5_Click()
Dim fila As Long, i As Long

fila = Hoja10.Range("b" & Rows.Count).End(xlUp).Row
ListBox1.Clear
For i = 2 To fila

    If CDate(Hoja10.Cells(i, 14)) >= CDate(f_inicial) And CDate(Hofa10.Cells(i, 14)) <= CDate(f_final) Then
    
     Me.ListBox1
     .AddItem
  .List(.ListCount - 1, 0) = Hoja10.Cells(i, 2)
  .List(.ListCount - 1, 2) = Hoja10.Cells(i, 0)
  .List(.ListCount - 1, 3) = Hoja10.Cells(i, 1)
  '.List(.ListCount - 1, 4) = Hoja10.Cells(i, 2)
  .List(.ListCount - 1, 5) = Hoja10.Cells(i, 2)
  .List(.ListCount - 1, 6) = Hoja10.Cells(i, 3)
  .List(.ListCount - 1, 7) = Hoja10.Cells(i, 4)
  .List(.ListCount - 1, ? = Hoja10.Cells(i, 5)
  .List(.ListCount - 1, 9) = Hoja10.Cells(i, 6)
  .List(.ListCount - 1, 10) = Hoja10.Cells(i, 7)
  .List(.ListCount - 1, 14) = Hoja10.Cells(i, ?
        
       End With
    
    End If
    
  Next i

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub TextBox1_Change()
'Declaramos variables
Dim fin As Long, i As Long, n As Long
Dim sCadena_seccion As String
'Filtramos por sección
With Sheets("BD_CONTROL")
fin = Application.CountA(.Range("B:B"))
If TextBox1 = "" Then
    Me.ListBox1.RowSource = ("B3:K") & Worksheets("BD_CONTROL").Range("B" & Rows.Count).End(xlUp).Row
    Exit Sub
End If
Me.TextBox2 = Clear
'Me.TextBox3 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To fin
    sCadena_matricula = .Cells(i, 2).Value
    If UCase(sCadena_matricula) Like "*" & UCase(TextBox1.Value) & "*" Then
        Me.ListBox1.AddItem
    
        Me.ListBox1.List(n, 0) = .Cells(i, 2).Value
        Me.ListBox1.List(n, 1) = .Cells(i, 3).Value
        Me.ListBox1.List(n, 2) = .Cells(i, 4).Value
        Me.ListBox1.List(n, 3) = .Cells(i, 5).Value
        Me.ListBox1.List(n, 4) = .Cells(i, 6).Value
        Me.ListBox1.List(n, 5) = .Cells(i, 7).Value
        Me.ListBox1.List(n, 6) = .Cells(i, 8).Value
        Me.ListBox1.List(n, 7) = .Cells(i, 9).Value
        Me.ListBox1.List(n, 8 = .Cells(i, 10).Value  'objetivos% 
        Me.ListBox1.List(n, 9) = .Cells(i, 11).Value
        n = n + 1
       End If
Next
Me.ListBox1.ColumnWidths = "55pt;170pt;55pt;55pt;55pt;65pt;65pt;65pt;60pt;50pt"
End With

End Sub

Private Sub TextBox2_Change()
Dim fin As Long, i As Long, n As Long
Dim sCadena_seccion As String, sCadena_fecha As String
'Una vez filtrados los datos por matricula, filtramos por fecha
With Sheets("BD_CONTROL")
fin = Application.CountA(.Range("B:B"))
If TextBox2 = "" Then
    Me.ListBox1.RowSource = ("B3:K") & Worksheets("BD_CONTROL").Range("B" & Rows.Count).End(xlUp).Row
    Exit Sub
End If

Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To fin
    sCadena_matricula = .Cells(i, 2).Value
    sCadena_fecha = .Cells(i, 11).Value
    If UCase(sCadena_matricula) Like "*" & UCase(TextBox1.Value) & "*" And _
    UCase(sCadena_fecha) Like "*" & UCase(TextBox2.Value) & "*" Then
     Me.ListBox1.AddItem
    
        Me.ListBox1.List(n, 0) = .Cells(i, 2).Value
        Me.ListBox1.List(n, 1) = .Cells(i, 3).Value
        Me.ListBox1.List(n, 2) = .Cells(i, 4).Value
        Me.ListBox1.List(n, 3) = .Cells(i, 5).Value
        Me.ListBox1.List(n, 4) = .Cells(i, 6).Value
        Me.ListBox1.List(n, 5) = .Cells(i, 7).Value
        Me.ListBox1.List(n, 6) = .Cells(i, 8).Value
        Me.ListBox1.List(n, 7) = .Cells(i, 9).Value
        Me.ListBox1.List(n, 8 = .Cells(i, 10).Value  'objetivos%  
        Me.ListBox1.List(n, 9) = .Cells(i, 11).Value
        n = n + 1
       End If
Next
Me.ListBox1.ColumnWidths = "55pt;170pt;55pt;55pt;55pt;65pt;65pt;65pt;60pt;50pt"
End With
End Sub

[Haplox]

@jalomiva , así no podemos hacer nada. Sube tu archivo de ejemplo para poder ver cómo arreglarlo

[jalomiva]

Buenas tardes adjunto imagen del mismo, esta es al importar lo hace correcto

[jalomiva]

y esta es con filtrado

[Antoni]

Hace 20 horas, Haplox dijo:

@jalomiva , así no podemos hacer nada. Sube tu archivo de ejemplo para poder ver cómo arreglarlo

¿Qué parte no has entendido de lo que te ha comentado José?

¿No te das cuentan que es imposible probar nada sin el archivo y que con las imágenes no hacemos nada?

[jalomiva]

Buenas tardes, hola Antoni no he tenido ningún problema al subir archivo hasta ahora, el libro lo he reducido a una hoja y aun así me sale el siguiente mensaje, pido disculpas porque al no poder adjuntar el archivo es eso de que una imagen vale más que mil palabras.

[Antoni]

Súbelo a un servidor de intercambio, DropBox, Mega, Google drive,........

[jalomiva]

https://drive.google.com/file/d/1hapSr7W5KUpfHwUaG_3RN4se7N_sJGGh/view?usp=sharing

Archivo compartido.

[Antoni]

Hace 28 minutos , jalomiva dijo:

https://drive.google.com/file/d/1hapSr7W5KUpfHwUaG_3RN4se7N_sJGGh/view?usp=sharing

Archivo compartido.

Acceso denegado ?

[jalomiva]

Buenas noches, lo he solucionado insertando el siguiente código (TextBox13.Text = Format(TextBox13.Text, "##.00") en el textbox del formulario donde relleno la base de datos.