Macro Excel VBA: Ayuda para optimizar y limpiar código
Publicado por Fer (2 intervenciones) el 28/05/2019 22:31:53
Hola A todos:
Tengo una hoja con datos en columnas con encabezados de Productos y kilos. Necesito ordenar y hacer subtotales.
No puedo usar una tabla dinámica, ya que se tiene que hacer solo y el resultado lo necesito como variable para otro cálculo (una matriz{profucto; kilos})
El código que hice funciona, pero necesito ayuda para optimizarlo y hacerlo función.
Primero levanto los datos de la hoja y cargo un array, luego ordeno el array, paso a calcular los subtotales y finalmente quito las filas vacías para terminar volcando esa matriz en una hoja.
Todo muy sucio...
Saludos y gracias de antemano.
Fernando
Tengo una hoja con datos en columnas con encabezados de Productos y kilos. Necesito ordenar y hacer subtotales.
No puedo usar una tabla dinámica, ya que se tiene que hacer solo y el resultado lo necesito como variable para otro cálculo (una matriz{profucto; kilos})
El código que hice funciona, pero necesito ayuda para optimizarlo y hacerlo función.
Primero levanto los datos de la hoja y cargo un array, luego ordeno el array, paso a calcular los subtotales y finalmente quito las filas vacías para terminar volcando esa matriz en una hoja.
Todo muy sucio...
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub subtotales()
Dim Mimatriz(), Temp() As Variant
Dim Aux As Variant
Dim Largo, Col, i, j, k As Integer
Col = 1Sheets("Data").Select
Largo = Cells(Rows.Count, 1).End(xlUp).Row
ReDim Mimatriz(0 To Largo - 1, Col)
ReDim Temp(o To Largo, Col)
'copio data en matriz
For i = 0 To Largo - 1
For j = 0 To ColMimatriz(i, j) = Cells(i + 1, j + 1).Value
Next
Next
For i = 1 To Largo - 1
For j = i + 1 To Largo - 1
If UCase(Mimatriz(i, 0)) > UCase(Mimatriz(j, 0)) Then
Temp(j, 0) = Mimatriz(j, 0)
Temp(j, 1) = Mimatriz(j, 1)
Mimatriz(j, 0) = Mimatriz(i, 0)
Mimatriz(j, 1) = Mimatriz(i, 1)
Mimatriz(i, 0) = Temp(j, 0)
Mimatriz(i, 1) = Temp(j, 1)
End If
Next j
Next i
For i = 1 To Largo - 2
If Mimatriz(i, 0) = Mimatriz(i + 1, 0) Then
Mimatriz(i, 0) = 0
Mimatriz(i + 1, 1) = Mimatriz(i, 1) + Mimatriz(i + 1, 1)
Mimatriz(i, 1) = 0
End If
Next i
Temp(0, 0) = Mimatriz(0, 0)
Temp(0, 1) = Mimatriz(0, 1)
For i = 1 To Largo - 1
If Mimatriz(i, 0) <> 0 Then
k = k + 1
Temp(k, 0) = Mimatriz(i, 0)
Temp(k, 1) = Mimatriz(i, 1)
End If
Next i
'Pego matriz en otra hoj
For i = 0 To k For j = 0 To 1Sheets("Hoja2").Cells(i + 1, j + 1).Value = Temp(i, j)
Next
Next
End Sub
Saludos y gracias de antemano.
Fernando
Valora esta pregunta
0
