Como volver ligero un código con muchos datos
¿Hay alguna manera de aligerar este código? Lo hice hace un tiempo con pocos datos y funcionaba excelente y rápido...
Ahora los datos que tengo son muchos + demasiados y pues ahora sigue funcionando pero con lentitud, se que esta mal como lo tengo pero espero me puedan corregir gracias:
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("productos")
uf = b.Range("B" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
If b.AutoFilterMode Then b.AutoFilterMode = False
Me.ListBox1.AddItem b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Format(Cells(i, "C"), """""$#,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 5) ' IVA col E
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 6) ' IEPS col F
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 4) ' PRECIO PUBLICO
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Format(Cells(i, "D"), """""$#,##0.00") ' PRECIO PUBLICO
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Format(Cells(i, "C"), """""$#,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Format(Cells(i, "E"), """""$#,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Format(Cells(i, "F"), """""$#,##0.00")
Exit Sub
End If
If b.AutoFilterMode Then b.AutoFilterMode = False
Me.ListBox1.Clear
'
For i = 3 To uf
strg = b.Cells(i, 2).Value
If UCase(strg) Like "*" & UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 2) ' PRODUCTO
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 3) 'PRECIO
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Format(Cells(i, "C"), """""$#,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 4) 'IVA
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Format(Cells(i, "E"), """""$#,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 5) 'IEPS
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Format(Cells(i, "F"), """""$#,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 4) ' PRECIO PUBLICO
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Format(Cells(i, "D"), """""$#,##0.00") ' PRECIO PUBLICO
FormPedido.ListBox1.ColumnWidths = "560 pt;120 pt;120 pt;180 pt;120pt"
End If
Next i
If ListBox1.ListCount > 0 Then
ver_PRODUCTOS.Label10.Caption = Empty
Else
MsgBox "No hay Producto Que Contenga Las Letras: " & "(-" & TextBox1.Value & "-)" & " Intenta De Nuevo, De Lo Contrario Hay Que Agregar El Producto", vbExclamation, "INFORMACIÓN UTIL"
End If
End Sub
1 Respuesta
Respuesta de Dante Amor
1
Prueba con esta opción Crea una hoja llamada "temp". Los títulos deberán estar en la fila2, y cada título de B2 hasta F2 deberán tener un título diferente y sin títulos vacíos.
Private Sub TextBox1_Change()
'Act.Por.Dante Amor
Set h1 = Sheets("productos")
Set h2 = Sheets("temp")
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Me.ListBox1.RowSource = ""
h2.Cells.Clear
FormPedido.ListBox1.ColumnWidths = "560 pt;120 pt;120 pt;180 pt;120pt"
If Trim(TextBox1.Value) = "" Then Exit Sub
'
u1 = h1.Range("B" & Rows.Count).End(xlUp).Row
h2.Range("A1") = h1.Range("B2")
h2.Range("A2") = TextBox1.Value
h1.Range("B2:F" & u1).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("A1:A2"), CopyToRange:=h2.Range("B1"), Unique:=False
'
u2 = h2.Range("B" & Rows.Count).End(xlUp).Row
If u2 = 1 Then
MsgBox "No hay Producto Que Contenga Las Letras: " & _
"(-" & TextBox1.Value & "-)" & " Intenta De Nuevo, De Lo Contrario Hay Que Agregar El Producto", vbExclamation, "INFORMACIÓN UTIL"
Else
h2.Columns("C:F").NumberFormat = "$#,##0.00"
ListBox1.RowSource = h2.Name & "!B2:F" & u2
End If
End Subsal u dos
