Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Macro Excel VBA: Ayuda para optimizar y limpiar código

Excel - Macro Excel VBA: Ayuda para optimizar y limpiar código

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil
Val: 3
Ha aumentado su posición en 10 puestos en Excel (en relación al último mes)
Gráfica de Excel

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...


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 = 1
Sheets("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 Col
    Mimatriz(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 1
    Sheets("Hoja2").Cells(i + 1, j + 1).Value = Temp(i, j)
  Next
Next
 
End Sub

Saludos y gracias de antemano.
Fernando
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro Excel VBA: Ayuda para optimizar y limpiar código

Publicado por Antoni Masana (2540 intervenciones) el 29/05/2019 02:45:43
Sin ver los datos no se que haces ni que pretendes hacer y siguiendo los comentarios del código pues es como leer una hoja en blanco.

Excel tiene herramientas para sacar totales y sub-totales que están muy optimizadas.

Ademas las Tablas Dinámicas se pueden crear con macros y es muchísimo más simple de programar

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 3
Ha aumentado su posición en 10 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro Excel VBA: Ayuda para optimizar y limpiar código

Publicado por Fer (2 intervenciones) el 29/05/2019 23:58:59
Hola Antoni
Te comento, tengo dos columnas, una con nombres y otra con cantidades. Pueden ser 15 ó 150000. Los nombres se pueden repetir.
Necesito una columna con nombres (sin repetir y ordenados) y otra con los subtotales.
La idea es que sea código por una cuestión de velocidad.
Necesito el resultado en una matriz (en el ejemplo lo pego en una hoja para visualizar)
Saludos y gracias,
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Nolberto
Val: 84
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro Excel VBA: Ayuda para optimizar y limpiar código

Publicado por Nolberto (128 intervenciones) el 30/05/2019 02:32:27
Esto puede ayudar, pero si manejas esa cantidad de datos, es inevitable que no sea tan rápido, en esto hay varios factores como la capacidad de procesamiento de la computadora, si hay formulas en el libro, etc.

Ahora, cuanto tiempo tarda con el código que tienes..?

Con el siguiente código se tarda 50 segundos en procesar 20 mil registros, resultando 10 mil productos únicos.

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
Sub test()
    Dim uFilaData, uFilaAcum, i As Long
    Dim rngData, rngKilos, rngProdAcum As Range
    Dim DataProdAcum() As Variant
    Dim Suma As Double
 
    Application.ScreenUpdating = False
 
    uFilaData = Hoja1.Cells(Rows.Count, 1).End(xlUp).Row 'ultima fila de la hoja base

    Set rngData = Hoja1.Range("A2:A" & uFilaData) 'columna que contiene los nombres de producto en la hoja base

    Set rngKilos = Hoja1.Range("B2:B" & uFilaData) 'columna que contiene los kilos en la hoja base

 
    Hoja2.Range("A2").CurrentRegion.ClearContents 'se eliminan todos los datos de la hoja destino

 
    'copia los datos unicos en la hoja destino

    Hoja1.Range("A2:A" & uFilaData).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=Hoja2.Range("A2"), _
        Unique:=True
 
    Application.CutCopyMode = False
 
    uFilaAcum = Hoja2.Cells(Rows.Count, 1).End(xlUp).Row 'ultima fila con datos en la hoja destino

    Set rngProdAcum = Hoja2.Range("A2:A" & uFilaAcum) 'rango de la columna productos en la hoja destino

    rngProdAcum.Sort key1:=rngProdAcum, order1:=xlAscending, Header:=xlNo 'ordenar columna de productos en hoja destino

    DataProdAcum = rngProdAcum.Value 'se pasan los datos de la columna productos a una matriz

 
    For i = 1 To UBound(DataProdAcum, 1)
        'se obtiene la suma del producto en turno en la iteracion

        Suma = Application.WorksheetFunction.SumIf(rngData, DataProdAcum(i, 1), rngKilos)
        'se agrega la suma en cada fila

        Hoja2.Cells(i + 1, 2) = Suma
        'se pone suma en cero para el siguiente producto

        Suma = 0
    Next i
 
    Application.ScreenUpdating = True
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Macro Excel VBA: Ayuda para optimizar y limpiar código

Publicado por jesus (1 intervención) el 30/08/2019 06:16:07
Hola disculpa pero no si me pueden ayudar estoy utilizando esto para imprimir el recibo de estado de cuenta me imprime todo la lista de clientes que tengo activo y inactivos
si me ayudan en alguna formula que imprima solo las filtradas de clientes activos le agradezco bendiciones

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub imprimir()
 
    inicio = Range("M12").Value
 
    fin = Range("O12").Value
 
        For i = inicio To fin
 
            Range("C10").FormulaR1C1 = i
 
            ActiveWindow.SelectedSheets.PrintOut Copies:=1
 
         Next
 
          Range("C10") = ""
 
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar