Se puede sumar con macros con diferentes rangos

Buenas tardes:
Necesito que me den una ayuda con relación a una macro, y necesito adecuarda a un resultado que necesito sacar .
A continuación paso a explicarles lo siguiente:
A B C D F G H I
1 LT0001G-067691 LTBO GMD 01/11/2009 03/11/2009 EE 134.94
2 LT0001G-067692 LTBO GME 01/11/2009 06/11/2009 PP 100.00
3 LT0001G-067693 LTBO GMN 01/11/2009 03/11/2009 EE 100.00
4 LT0001G-067694 LTPE GMD 02/11/2009 02/11/2009 AA 357.48
5 CL0001G-394701 CLPE GMD 02/11/2009 02/11/2009 EE 320.00
6 CL0001G-394702 CLPE GME 03/11/2009 03/11/2009 EE 40.00
La columna A = id operacion
La columna B = numero de operacion
La columna C = codigo
La columna D = moneda (GMD= DOLARES , GMN= SOLES, GME= EUROS)
La columna F = Fecha de la operacion
La columna G = Fecha de pago o cancelacion
La columna H = Estado de la operacion
La columna I = Monto
Necesito sumar por diferentes condicionales con una macro, por fechas con sus estados y monedas.
Espero haberme explicado de la mejor manera y por favor si alguien pueda ayudarme estaré muy agradecido.
este es el codigo que estoy utilizando , no me suma los euros
Sub Reportes()
Dim uf1 As Long, uf2 As Long, uf3 As Long
    With Sheets("WEB")
        Sheets.Add.Range("a1:d1") = Array("ORIDEST", "Moneda", "Operaciones", "Importe")
        'uf1 = .Range("c" & Rows.Count).End(xlUp).Row
        '.Range("c1:c" & uf1).AdvancedFilter xlFilterCopy, , Range("a2"), 1
        uf1 = .Range("c" & Rows.Count).End(xlUp).Row
        .Range("c2:c" & uf1, "d2:d" & uf1).AdvancedFilter 2, , Range("a2"), 1
        With Range("a1", "a1")
         'With Range("a1", "d1")
            .Offset(1).Delete
            uf2 = .CurrentRegion.Rows.Count
            uf4 = .CurrentRegion.Rows.Count
            .Offset(1, 2).Resize(uf2 - 1) = _
            Evaluate("index(countif('WEB'!c2:c" & uf1 & ",a2:a" & uf2 & "),0)")
            .Offset(1, 3).Resize(uf2 - 1) = _
             Evaluate("index(sumif('WEB'!c2:c" & uf1 & ",a2:a" & uf2 & ",'WEB'!k2:k" & uf1 & "),0)")
        End With
    End With
End Sub

1 Respuesta

Respuesta
1
Dame ejemplo de las CONDICIONALES que aplicas.
-
A B C D F G H I
1  LT0001G-067691   LTBO GMD 01/11/2009 03/11/2009 EE 134.94
2  LT0001G-067692   LTBO GME 01/11/2009 06/11/2009 PP 100.00
3  LT0001G-067693   LTBO GMN 01/11/2009 03/11/2009 EE 100.00
4  LT0001G-067694   LTPE GMD 02/11/2009 02/11/2009 AA 357.48
5  CL0001G-394701  LTPE GMD 02/11/2009 02/11/2009 EE 320.00
6  CL0001G-394702  CLPE GME 03/11/2009 03/11/2009 EE 40.00
La columna A = id operacion
La columna B = numero de operacion
La columna C = codigo
La columna D = moneda (GMD= DOLARES , GMN= SOLES, GME= EUROS)
La columna F = Fecha de la operacion
La columna G = Fecha de pago o cancelacion
La columna H = Estado de la operacion
La columna I = Monto
Estas son cada columnas quiero que por el columna C y columna D se respete por moneda :
                CODIGO        MONEDA    ESTADO                             TOTAL
Ejemplo  LTBO              GMD             EE                               =  134.94
               LTBO              GME             PP                                =  100.00
               LTBO              GMN            EE                                 =  100.00
               LTPE              GMD           AA                                  =  357.48
               LTPE              GMD           EE                                  =  320.48
               CLPE              GME           EE                                  =  40.00
Esos resultados necesito obtener y que no se repitan según criterio,
CÓDIGO
MONEDA
ESTADO
Y sumen por el campo (I) Y salga su total
Espero pronta respuesta
Gracias de antemano.
Vaya... ¿Buscas un resumen por CODIGO+MONEDA+ESTADO?
-
Ei es así, con una columna adicional y el uso de subtotales lo tendrías al momento.
-
En esta caso, todas las combinaciones son distintas y el resultado, es la misma tabla de datos.
-
Ahora, si quieres un resultado por CÓDIGO, otro por MONEDA y otro por ESTADO, entonces la hay diferencias e igual puedes utilizar, de DATOS la opción SUBTOTALES, para lo cual, es necesario primero ORDENAR por CRITERIO y luego aplicar SUBTOTALES.
-
Tu dices... por donde nos vamos.
-
Si mira te puedo adjunto mi ejemplo que tengo, lo que pasa que la data son más e 50 mil registros y por subtotales no lo veo, también se puede por tablas dinámicas, pero lo que quiero es hacerlo mediante la macro, ya que con un clic me lo ordenaría y lo sumaria, mira tengo el ejemplo, en excel, dime como puedo subirlo par que me des una mano.
Se podrá
Nota: Te adjunto mi ejemplo
Bájelo de megaupload
Por favor de esta urgl

http://www.megaupload.com/?d=Z5EOHFD6
En este caso, me esta duplicando y no me suma por Moneda.
Espero pronta respuesta
Muchas gracias
El resultado, en realidad me da así:
-
ORIDEST Moneda Operaciones Importe
CLPE         GMD         1                    320
CLPE         GME         1                      40
CLPE         GMN         1                      30
LTBO         GMD         2                    424.94
LTBO         GME         1                    100 
LTBO         GMN         1                    100 
LTPE         GMD         1                     357.48 
RIAR         GMD         3                   2030 
-
El código es el siguiente:
-
Sub Reportes()
' Cuenta el número de filas
Sheets("WEB"). Activate
 For Each CELDA In Range("C:C")
  If CELDA.Value = "" Then Exit For
 Next CELDA
 ' ORDENA LA BASE DE DATOS
 Sheets("WEB").Sort.SortFields.Clear
 Sheets("WEB").Sort.SortFields.Add Key:=Range("C2:C" & (CELDA.Row - 1)), _
  SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 Sheets("WEB").Sort.SortFields.Add Key:=Range("D2:D" & (CELDA.Row - 1)), _
  SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("WEB").Sort
  .SetRange Range("A1:K" & (CELDA.Row - 1))
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
 End With
 ' CUENTA Y SUMA POR CRITERIO
 ORIDEST = ""
 CODCON = ""
 CONTEO = 0
 IMPORTE = 0
 F = 1
 Sheets("HOJA1").Activate
 Range("A2").Activate
 ' INICIA EL RECORRIDO DE LA BASE DE DATOS
 For I = 2 To CELDA.Row - 1
  ' DETERMINA CASO
  If Sheets("WEB").Range("C" & I).Value = ORIDEST And _
   Sheets("WEB").Range("D" & I).Value = CODCON Then
   ' CONTEO EXISTENTE
   Range("C" & F).Value = Range("C" & F).Value + 1
   Range("D" & F).Value = Range("D" & F).Value + Sheets("WEB").Range("K" &    I).Value
  Else
   ' CONTEO NUEVO
   F = F + 1
   ' OBTIENE DATOS DEL ORIGEN
   ORIDEST = Sheets("WEB").Range("C" & I).Value
   CODCON = Sheets("WEB").Range("D" & I).Value
   CONTEO = 1
   IMPORTE = Sheets("WEB").Range("K" & I).Value
   ' ACTUALIZA REGISTROS
   Range("A" & F).Value = ORIDEST
   Range("B" & F).Value = CODCON
   Range("C" & F).Value = CONTEO
   Range("D" & F).Value = IMPORTE
  End If
 Next
End Sub
-
Gracias lo verificare, muchas gracias
Mi estimado de antemano gracias por el aporte, pero te cuento se demora mucho, con el código anterior que te pase era más rapido, pero se demora en algunos casos no sale la sumatoria y esta en cero.
Espero su ayuda, muchas gracias
Tienes razón; con 50,000 registros ya es algo intolerable.
Bueno, un poco de manejo de variables y el código se optimizó un poco.
-
Sub Reportes()
' Cuenta el número de filas
Sheets("WEB"). Activate
 For Each CELDA In Range("C:C")
  If CELDA.Value = "" Then Exit For
 Next CELDA
 ' ORDENA LA BASE DE DATOS
 Sheets("WEB").Sort.SortFields.Clear
 Sheets("WEB").Sort.SortFields.Add Key:=Range("C2:C" & (CELDA.Row - 1)), _
 SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 Sheets("WEB").Sort.SortFields.Add Key:=Range("D2:D" & (CELDA.Row - 1)), _
 SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 With ActiveWorkbook.Worksheets("WEB").Sort
  .SetRange Range("A1:K" & (CELDA.Row - 1))
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
 End With
 ' CUENTA Y SUMA POR CRITERIO
 F = 2
 Sheets("HOJA1").Activate
 Range("A2").Activate
 ' DATOS INICIALES
 ORIDEST = Sheets("WEB").Range("C" & 2).Value
 CODCON = Sheets("WEB").Range("D" & 2).Value
 CONTEO = 0
 IMPORTE = 0
 ' INICIA EL RECORRIDO DE LA BASE DE DATOS
 For I = 2 To CELDA.Row - 1
  ' DETERMINA CASO
  If Sheets("WEB").Range("C" & I).Value = ORIDEST And _
   Sheets("WEB").Range("D" & I).Value = CODCON Then
   ' CONTEO EXISTENTE
   EL_CONTEO = EL_CONTEO + 1
   LA_SUMA = LA_SUMA + Sheets("WEB").Range("K" & I).Value
  Else
   ' ACTUALIZA REGISTROS
   Range("A" & F).Value = ORIDEST
   Range("B" & F).Value = CODCON
   Range("C" & F).Value = EL_CONTEO
   Range("D" & F).Value = LA_SUMA
   ' CONTEO NUEVO
   F = F + 1
   ' OBTIENE DATOS DEL NUEVO ORIGEN
   ORIDEST = Sheets("WEB").Range("C" & I).Value
   CODCON = Sheets("WEB").Range("D" & I).Value
   EL_CONTEO = 1
   LA_SUMA = Sheets("WEB").Range("K" & I).Value
  End If
 Next
 ' Datos finales
 Range("A" & F).Value = ORIDEST
 Range("B" & F).Value = CODCON
 Range("C" & F).Value = EL_CONTEO
 Range("D" & F).Value = LA_SUMA
End Sub
-
Muchas gracias, si podría colocarle una variable de fecha, me permita escoger los dos rangos de fecha y haga la sumatoria.
EJemplo: la sumatoria que da ahorita esta perfecto:
Pero si en una HOJA2 nueva pongo un rango de fechas :
      A B
01/09/2010    30/09/2010
Nota: quisiera que agarre las variables de fecha y siga el rrecorrido del código que me brindo, muchas gracias.
Muchas gracias, si podría colocarle una variable de fecha, me permita escoger los dos rangos de fecha y haga la sumatoria.
EJemplo: la sumatoria que da ahorita esta perfecto:
Pero si en una HOJA2 nueva pongo un rango de fechas :
      A B
01/09/2010    30/09/2010
Nota: quisiera que agarre las variables de fecha y siga el rrecorrido del código que me brindo, muchas gracias.
Nota: dígame si es posible trata vía correo personal, algunos pedidos o requerimientos a tratar personalmente .
Espero su pronta respuesta.
Más optimizado y con los filtros de fecha
-
Xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Sub Reportes()
Dim I, INICIO, FILA, EL_CONTEO, REGISTROS As Single
Dim LA_SUMA As Double
Dim ORIDEST, CODCON As String
Dim FECHA1, FECHA2 As Date
Dim DATOS As Range
' Cuenta el número de filas
Sheets("WEB").Activate
Range("B1").Activate
Set DATOS = ActiveCell.CurrentRegion
DATOS.Select
REGISTROS = DATOS.Rows.Count + 1
' ORDENA LA BASE DE DATOS
Sheets("WEB").Sort.SortFields.Clear
Sheets("WEB").Sort.SortFields.Add Key:=Range("C2:C" & (REGISTROS - 1)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Sheets("WEB").Sort.SortFields.Add Key:=Range("D2:D" & (REGISTROS - 1)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("WEB").Sort
.SetRange Range("A1:K" & (REGISTROS - 1))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' CUENTA Y SUMA POR CRITERIO
INICIO = 2 ' Fila en análisis
Sheets("HOJA1").Activate
Range("A2").Activate
' BUSCA UN INICIO VALIDO
FECHA1 = Sheets("Hoja2").Range("A1")
FECHA2 = Sheets("Hoja2").Range("B1")
Do While (REGISTROS - 1) > INICIO
If Sheets("WEB").Range("E" & INICIO).Value >= FECHA1 And _
Sheets("WEB").Range("E" & INICIO).Value <= FECHA2 Then
ORIDEST = Sheets("WEB").Range("C" & 2).Value
CODCON = Sheets("WEB").Range("D" & 2).Value
Exit Do
End If
INICIO = INICIO + 1
Loop
If INICIO = REGISTROS Then
MsgBox "No hay coincidencias"
Exit Sub
End If
' INICIA EL RECORRIDO DE LA BASE DE DATOS
CONTEO = 0
IMPORTE = 0
FILA = 2
For I = INICIO To REGISTROS - 1
' DETERMINA CASO
If Sheets("WEB").Range("C" & I).Value = ORIDEST And _
Sheets("WEB").Range("D" & I).Value = CODCON Then
' CONTEO EXISTENTE
If Sheets("WEB").Range("E" & I).Value >= FECHA1 And _
Sheets("WEB").Range("E" & I).Value <= FECHA2 Then
EL_CONTEO = EL_CONTEO + 1
LA_SUMA = LA_SUMA + Sheets("WEB").Range("K" & I).Value
End If
Else
' ACTUALIZA REGISTROS
Range("A" & FILA).Value = ORIDEST
Range("B" & FILA).Value = CODCON
Range("C" & FILA).Value = EL_CONTEO
Range("D" & FILA).Value = LA_SUMA
' CONTEO NUEVO
FILA = FILA + 1
' OBTIENE DATOS DEL ORIGEN
ORIDEST = Sheets("WEB").Range("C" & I).Value
CODCON = Sheets("WEB").Range("D" & I).Value
If Sheets("WEB").Range("E" & I).Value >= FECHA1 And _
Sheets("WEB").Range("E" & I).Value <= FECHA2 Then
EL_CONTEO = 1
LA_SUMA = Sheets("WEB").Range("K" & I).Value
Else
EL_CONTEO = 0
LA_SUMA = 0
End If
End If
Next
Range("A" & FILA).Value = ORIDEST
Range("B" & FILA).Value = CODCON
Range("C" & FILA).Value = EL_CONTEO
Range("D" & FILA).Value = LA_SUMA
End Sub
-
Xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas