Cómo cargar datos en el listbox de manera dinámica aplicando un filtro de lo que vas capturando en un textbox o en 2 textbox.
También en el vídeo muestro como ajustar el ancho de columna, formatear una fecha, formatear importes y también alinear los importes a la derecha.
______________
Option Explicit
Dim a As Variant
Dim sh As Worksheet
Private Sub UserForm_Activate()
Dim b As Variant
Dim cWidth As String
Dim i As Long, j As Long, n As Long
Dim importe As String
Set sh = Worksheets("Datos1")
a = sh.Range("A1:H" & sh.Range("A" & Rows.Count).End(xlUp).Row).Value2
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
With ListBox1
.ColumnCount = UBound(a, 2)
'Ajustar ancho de columnas
sh.Range("A1", sh.Cells(1, UBound(a, 2))).EntireColumn.AutoFit
For i = 1 To UBound(a, 2)
If i > 5 Then n = 15
cWidth = cWidth & Int(sh.Cells(1, i).Width) + n & "; "
Next
.ColumnWidths = cWidth
.Font.Name = "Consolas"
.Font.Size = 10
'Formato de columnas
For i = 1 To UBound(a, 1)
For j = 1 To UBound(a, 2)
Select Case j
Case 1 To 4
b(i, j) = a(i, j)
Case 5
b(i, j) = Format(a(i, j), "dd/mm/yyyy")
Case 6, 7, 8
importe = Format(a(i, j), "#,##0.00")
b(i, j) = String(9 - Len(importe), " ") & importe
End Select
Next
Next
.List = b
End With
End Sub
Sub Filter_Data()
Dim i As Long, j As Long, k As Long
Dim txt1 As String, txt2 As String, importe As String
Dim b As Variant
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
'Agregar títulos
For j = 1 To UBound(b, 2)
b(1, j) = a(1, j)
Next
k = 1
For i = 2 To UBound(a, 1)
If TextBox1.Text = "" Then txt1 = a(i, 1) Else txt1 = TextBox1.Text 'textbox1 busca en A
If TextBox2.Text = "" Then txt2 = a(i, 2) Else txt2 = TextBox2.Text 'textbox2 busca en B
If LCase(a(i, 1)) Like "*" & LCase(txt1) & "*" And _
LCase(a(i, 2)) Like "*" & LCase(txt2) & "*" Then
k = k + 1
For j = 1 To UBound(a, 2)
Select Case j
Case 1 To 4
b(k, j) = a(i, j)
Case 5
b(k, j) = Format(a(i, j), "dd/mm/yyyy")
Case 6, 7, 8
importe = Format(a(i, j), "#,##0.00")
b(k, j) = String(9 - Len(importe), " ") & importe
End Select
Next
End If
Next
ListBox1.List = b
End Sub
Private Sub TextBox1_Change()
Call Filter_Data
End Sub
Private Sub TextBox2_Change()
Call Filter_Data
End Sub
__________________
Descarga el archivo:
No hay comentarios.:
Publicar un comentario