Ajustar esta macro a los parámetros nuevos
Tengo esta maro:
Private Sub Worksheet_Activate()
'Por.Dante Amor
ActiveSheet.Unprotect Password:="1"
Application.EnableEvents = False
Set h = Sheets("Diario Venta")
'limpiar colores
h.Range("D4:AH15").Interior.ColorIndex = xlNone
h.Range("D4:AH15").Font.ColorIndex = xlAutomatic
mes = Format(Date, "mmmm")
dia = Day(Date)
Set b = h.Range("C4:C15").Find(mes, LookAt:=xlWhole)
If Not b Is Nothing Then
f = b.Row
Set b = h.Range("D2:AH2").Find(dia, LookAt:=xlWhole)
If Not b Is Nothing Then
C = b.Column
For i = 4 To f
For J = 4 To 34
If i = f And J = C Then
Exit For
End If
conta = conta + h.Cells(i, J)
Next
Next
ventatotal = h.[A4]
h.Cells(f, C) = ventatotal - conta
h.Cells(f, C).Interior.ColorIndex = 28
h.Cells(f, C).Font.ColorIndex = 1
End If
End If
Application.EnableEvents = True
End Sub
Y la he rectificado así:
Private Sub Worksheet_Activate()
'ActiveSheet.ScrollArea = "A:S"
'Por.Dante Amor
ActiveSheet.Unprotect Password:="1"
Application.EnableEvents = False
Set h = Sheets("Diario Venta")
'limpiar colores
h.Range("D5:S28").Interior.ColorIndex = xlNone
h.Range("D5:S28").Font.ColorIndex = xlAutomatic
mes = Format(Date, "mmmm")
dia = Day(Date)
Set b = h.Range("C5:C28").Find(mes, LookAt:=xlWhole)
If Not b Is Nothing Then
f = b.Row
Set b = h.Range("D2:AH2").Find(dia, LookAt:=xlWhole)
If Not b Is Nothing Then
C = b.Column
For i = 4 To f
For J = 4 To 34
If i = f And J = C Then
Exit For
End If
conta = conta + h.Cells(i, J)
Next
Next
ventatotal = h.[A5]
h.Cells(f, C) = ventatotal - conta
h.Cells(f, C).Interior.ColorIndex = 28
h.Cells(f, C).Font.ColorIndex = 1
End If
End If
Application.EnableEvents = True
End Sub
Y no se actualizar esta parte de la macro, al haber cambiado los rangos:
If Not b Is Nothing Then
C = b.Column
For i = 4 To f
For J = 4 To 34
If i = f And J = C Then
Exit For
End If
conta = conta + h.Cells(i, J)
Next
Next
Y lo que me hace, es escribir fuera del rango:
Range("D5:S28")
1 Respuesta
Macro para el rango de D5 a S28
Private Sub Worksheet_Activate()
'ActiveSheet.ScrollArea = "A:S"
'Por.Dante Amor
ActiveSheet.Unprotect Password:="1"
Application.EnableEvents = False
Set h = Sheets("Diario Venta")
'limpiar colores
h.Range("D5:S28").Interior.ColorIndex = xlNone
h.Range("D5:S28").Font.ColorIndex = xlAutomatic
mes = Format(Date, "mmmm")
dia = Day(Date)
Set b = h.Range("C5:C28").Find(mes, LookAt:=xlWhole)
If Not b Is Nothing Then
f = b.Row
Set b = h.Range("D2:S2").Find(dia, LookAt:=xlWhole)
If Not b Is Nothing Then
C = b.Column
For i = 5 To f
For J = 4 To 34
If i = f And J = C Then
Exit For
End If
conta = conta + h.Cells(i, J)
Next
Next
ventatotal = h.[A5]
h.Cells(f, C) = ventatotal - conta
h.Cells(f, C).Interior.ColorIndex = 28
h.Cells(f, C).Font.ColorIndex = 1
End If
End If
Application.EnableEvents = True
End Subsal u dos
Esta no me funciona
Saludos
Macro ajustada
Private Sub Worksheet_Activate()
'ActiveSheet.ScrollArea = "A:S"
'Por.Dante Amor
ActiveSheet.Unprotect Password:="1"
Application.EnableEvents = False
Set h = Sheets("Diario Venta")
'limpiar colores
h.Range("D5:S28").Interior.ColorIndex = xlNone
h.Range("D5:S28").Font.ColorIndex = xlAutomatic
mes = Format(Date, "mmmm")
'dia = Day(Date)
dia = 4
Set b = h.Range("C5:C28").Find(mes, LookAt:=xlWhole)
If Not b Is Nothing Then
f = b.Row
c = 0
Set b = h.Range("D2:S2").Find(dia, LookAt:=xlWhole)
If Not b Is Nothing Then
c = b.Column
Else
Set b = h.Range("D3:S3").Find(dia, LookAt:=xlWhole)
If Not b Is Nothing Then
c = b.Column
f = f + 1
End If
End If
If c > 0 Then
For i = 4 To f
For J = 4 To 34
If i = f And J = c Then
Exit For
End If
conta = conta + h.Cells(i, J)
Next
Next
ventatotal = h.[A5]
h.Cells(f, c) = ventatotal - conta
h.Cells(f, c).Interior.ColorIndex = 28
h.Cells(f, c).Font.ColorIndex = 1
End If
End If
Application.EnableEvents = True
End Subsal u dos
Dante no se como agradecerte.
Empecé yo solo en excel hace tres años
Y tengo 69 tacos
Me esta costando bastante
Un saludo
