Agrupar por cedula o NIT del cliente

10/12/2011 - 21:04 por ihurtado | Informe spam
Buenas tardes. Alguien me podria ayudar con optimiza este codigo de una macro para Excel. La primera parte de la macro (Resumelo) hace un recorrido de los datos de la hoja 1 (15.000 registros en en total) de una tabla que se importo a traves de una vista en SQL server.
La segunda parte de la macro (Limpialo) limpia los resultados de la hoja 4 para poder ingresar los datos nuevamente.
Lo que me preocupa es que veo que hay algunos valores que no estan sacando los valores correspondientes.
Dejo la macro para ver si alguien me puede ayidar con este tema:

Option Explicit

Sub resumelo()
Dim i As Long
Dim xFil As Long
Dim uFil As Long
Dim cols As Variant
Dim culs As Variant
Dim rit As Variant
Dim celda As Range
Dim rng As Range
Dim lacelda As String
Dim lasuma As Currency
Dim valio As Currency
Dim celdos As Variant
Dim celdes As Variant
Dim inici As Date
Dim finiti As Date

culs = Array(1, 24, 4, 26)
cols = Array(2, 3, 4, 8)
celdos = Array("C14", "C15", "C16", "E14", "E15", "G14", "G15", "G16", "I14")
celdes = Array(5, 17, 18, 2, 19, 20, 21, 16, 22)

If Range("C2") = Empty Then MsgBox "No posee rut para realizar busqueda", vbCritical, " ¡ ¡ E R R O R ! ! ": Exit Sub
rit = Range("C2")
limpialo
lasuma = 0
Set rng = Hoja1.Range("B2:B" & Hoja1.Range("B" & Rows.Count).End(xlUp).Row)
With rng
Set celda = .Find(rit)
If Not celda Is Nothing Then
lacelda = celda.Address
For i = 0 To UBound(celdos)
Range(celdos(i)) = Hoja1.Cells(celda.Row, celdes(i))
Next i
Do
xFil = celda.Row
uFil = Range("B" & Rows.Count).End(xlUp)(2).Row
For i = 0 To 3
If i = 2 Then Cells(uFil, cols(i)) = CDate(Hoja1.Cells(xFil, culs(i))) Else Cells(uFil, cols(i)) = Hoja1.Cells(xFil, culs(i))
Next i
valio = Hoja1.Cells(xFil, 15)
Select Case Hoja1.Cells(xFil, 3)
Case Is > 0: Cells(uFil, 5) = valio: lasuma = lasuma + valio
Case Is < 0: Cells(uFil, 6) = valio * (-1): lasuma = lasuma - valio
End Select
Cells(uFil, 7) = lasuma
Range("B" & uFil & ":H" & uFil).Borders.LineStyle = xlContinuous
Set celda = .FindNext(celda)
Loop While Not celda Is Nothing And celda.Address <> lacelda
End If
End With

inici = WorksheetFunction.Min(Range("D:D"))
finiti = WorksheetFunction.Max(Range("D:D"))

Range("B12") = "ESTADO DE CUENTA DEL " & Format(inici, "dd mmmm yyyy") & " al " & Format(finiti, "dd mmmm yyyy")
End Sub


Sub limpialo()
Range("C14:C16").ClearContents
Range("E14:E16").ClearContents
Range("G14:G16").ClearContents
Range("I14").ClearContents
With Range("B19:I" & Range("B" & Rows.Count).End(xlUp)(3).Row)
.ClearContents
.Borders.LineStyle = xlNone
End With
If Application.Caller = "Limpio" Then Range("C2:C3").ClearContents
Range("B12") = "ESTADO DE CUENTA DEL " & " al "

End Sub

Preguntas similare

Leer las respuestas

Search Busqueda sugerida