Pregunta para Dante Amor: Sumar hasta bajo condiciones múltiples
Hola Dante Amor. Esta macro resulta muy bien, pero mi pregunta estaba mal planteada. En realidad yo quisiera que me sumara hasta la fecha de referencia. No sólo la fecha que indica en la fila 2. Es decir sumar hasta el 24 de Agosto. No buscar sólo los valores que están bajo la fecha 24 de agosto. O Si es muy complicado por último definir las fechas en dos filas distintas desde - hasta. Por ejemplo desde el 01-08-2014 hasta el 14-08-2014.(Fila 1 desde y fila2 hasta) aunque lo primero seria genial. Lo otro si esta macro la ejecuto 2 ó más veces en forma seguidas me va sumando sobre la suma una y otra vez. ¿Se puede resolver eso?. Cosa que si ejecuto dos veces si hay cifras nuevas que actualice y no sume sobre si misma.
Sub proveedores()
'Por.DAM
Set h1 = Sheets("Proveedores")
Set h2 = Sheets("Hoja2")
u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
v = h2.UsedRange.Columns(h2.UsedRange.Columns.Count).Column + 1
h2.Range(h2.Cells(3, 4), h2.Cells(u, v)).ClearContents
For i = 2 To h1.Range("O" & Rows.Count).End(xlUp).Row
s = h1.Cells(i, "M")
Set b = h2.Range("B:B").Find(h1.Cells(i, "O"), lookat:=xlWhole)
If Not b Is Nothing Then
f = b.Row
Set c = h2.Rows(2).Find(h1.Cells(i, "H"))
If Not c Is Nothing Then
h2.Cells(f, c.Column) = h2.Cells(f, c.Column) + s
End If
Else
Set o = h2.Range("B:B").Find("OTROS", lookat:=xlPart)
If Not o Is Nothing Then
f = o.Row
Set c = h2.Rows(2).Find(h1.Cells(i, "H"))
If Not c Is Nothing Then
h2.Cells(f, c.Column) = h2.Cells(f, c.Column) + s
End If
End If
End If
Next
End Sub
1 respuesta
No entendí bien a qué te refieres con sumar hasta la fecha de referencia, por ejemplo para la primer fecha que tienes en tu imagen 15-08-2014, ¿desde cuál fecha y hasta cuál fecha debe sumar?
Para el siguiente ejemplo que tienes la fecha 16-08-2014, ¿desde cuál fecha y hasta cuál fecha debe sumar?
Por último, tampoco entendí, cada vez que ejecutes la macro qué opción quieres:
Opción A) que siga acumulando.
Opción B) que borre y pongas las nuevas sumas
Actualmente la macro borra y pone las nuevas sumas (opción B)
Si eliges la opción A, si ejecutas una y otra vez y tus datos de proveedores no han cambiado, lo que va a hacer la macro es acumular una y otra vez, ¿y si no se limpian los valores y cambiaste las fechas o los proveedores principales?
Dante Amor.
Actualmente esta ejecutando la opción A. Es decir si ejecuta por segunda vez me suma valores acumulados. Opción B sería genial. Que borre y coloque las nuevas cifras. Respecto a la duda te adjunto la imagen.
Fila 1 fechas desde
Fila 2 fecha hasta la que debe sumar
y gracias por tu tiempo :)
No, actualmente hace la b, primero borra. Si cambiaste de ubicación los datos hay que ajustar la macro para que borre correctamente, revisa en la macro y esta la instrccion clearcontents.
Es correcto lo que dices disculpa!, ya lo corregí. Estaba en fila 3 columna 4. Cuando yo los datos los tengo en columna 3
¿Pero lo condición de la fecha desde?. ¿Se puede agregar?
Esta es la macro.
Recuerda que los datos deberán estar tal y como pusiste tu imagen.
Recuerda que las fechas deberán ser fechas validas.
Sub proveedores()
'Por.DAM
Set h1 = Sheets("Proveedores")
Set h2 = Sheets("Hoja2")
'
u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
v = h2.UsedRange.Columns(h2.UsedRange.Columns.Count).Column + 1
h2.Range(h2.Cells(3, 3), h2.Cells(u, v)).ClearContents
'
For i = 2 To h1.Range("O" & Rows.Count).End(xlUp).Row
s = h1.Cells(i, "M")
Set b = h2.Range("B:B").Find(h1.Cells(i, "O"), lookat:=xlWhole)
If Not b Is Nothing Then
f = b.Row
'
For j = 3 To h2.Cells(1, Columns.Count).End(xlToLeft).Column
If h1.Cells(i, "H") >= h2.Cells(1, j) And _
h1.Cells(i, "H") <= h2.Cells(2, j) Then
h2.Cells(f, j) = h2.Cells(f, j) + s
Exit For
End If
Next
Else
Set o = h2.Range("B:B").Find("OTROS", lookat:=xlPart)
If Not o Is Nothing Then
f = o.Row
'
For j = 3 To h2.Cells(1, Columns.Count).End(xlToLeft).Column
If h1.Cells(i, "H") >= h2.Cells(1, j) And _
h1.Cells(i, "H") <= h2.Cells(2, j) Then
h2.Cells(f, j) = h2.Cells(f, j) + s
Exit For
End If
Next
End If
End If
Next
End Sub
¡Gracias!
Realmente esto de las macros le facilita el trabajo a uno. Ojala algun dia pueda programar asi de bien. Por lo pronto algo entiendo,
Excelente Dan Amor
Es lo que necesitaba
