Hacer cálculos con macro aplicando fórmulas
Tengo una macro, que me hace una serie de cálculos, antes me los hacía correctamente, pero a partir de una modificación en la macro (para que me calculara los Teras del documento y los resultados salieran como números) ya no salen correctamente los cálculos. He intentado por todos los medios corregir el fallo pero no logro encontrarlo. Os paso el código
Un abrazo!
Alberto
1 Respuesta
Respuesta de Dante Amor
1
Anexo la macro
Sub SetorZaragoza()
'Por.Dante Amor
Dim filas()
Dim sectores()
Set h1 = Sheets("DATOS")
Set h2 = Sheets("RESUMEN")
'
'Buscar fecha en datos
Set b = h1.Rows(1).Find("-", lookat:=xlPart)
If Not b Is Nothing Then
fecha = CDate(b.Value)
Else
Set b = h1.Rows(1).Find("/", lookat:=xlPart)
If Not b Is Nothing Then
fecha = CDate(b.Value)
Else
fecha = Date
End If
End If
'
'Buscar fecha en Resumen
Set b = h2.Rows(1).Find(fecha, lookat:=xlWhole)
If Not b Is Nothing Then
col = b.Column
Else
col = h2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
h2.Cells(1, col) = CDate(Format(fecha, "dd/mm/yyyy"))
End If
'
'Buscar sectores
bsectores = Array("WALQA", "ZARAGOZA")
n = 0
Set r = h1.Columns("A")
For k = LBound(bsectores) To UBound(bsectores)
Set b = r.Find(bsectores(k), lookat:=xlPart)
If Not b Is Nothing Then
Celda = b.Address
Do
n = n + 1
ReDim Preserve filas(n)
ReDim Preserve sectores(n)
filas(n) = b.Row
sectores(n) = b.Value
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> Celda
End If
Next
'
'Pasar Datos
For i = 1 To n
wn = 0
vtot = 0
vvol = 0
fila = filas(i)
dato = h1.Cells(fila, "A")
If InStr(1, LCase(dato), "zaragoza") > 1 Then
w1 = 6: w2 = 4
Else
w1 = 1: w2 = 2
End If
ufila = h1.Cells(fila + w1, "C").End(xlDown).Row
For j = fila + w2 To ufila
Select Case h1.Cells(j, "C")
Case "/mnt/logs": vlog = h1.Cells(j, "A")
Case "/mnt/vols/vol_C000", "/mnt/vols/vol_B000": v000 = h1.Cells(j, "A")
Case "/mnt/mensajes"
vmen = h1.Cells(j, "A")
Case Else
If IsNumeric(h1.Cells(j, "B")) And h1.Cells(j, "B") <> "" Then
wn = wn + 1
vtot = vtot + h1.Cells(j, "B") * 100
End If
If h1.Cells(j, "A") <> "" Then
If InStr(1, h1.Cells(j, "A"), "T") > 0 Then
vlibre = Replace(h1.Cells(j, "A"), "T", "")
'vlibre = Replace(vlibre, ".", ",")
vlibre = Val(vlibre) * 1024
Else
vlibre = Replace(h1.Cells(j, "A"), "G", "")
vlibre = Replace(vlibre, ".", ",")
End If
If IsNumeric(vlibre) Then
vvol = vvol + Val(vlibre)
End If
End If
End Select
Next
'
sector = sectores(i)
Set b = h2.Columns("A").Find(sector, lookat:=xlWhole)
If Not b Is Nothing Then
fil = b.Row
Else
fil = h2.Range("A" & Rows.Count).End(xlUp).Row + 2
End If
'
h2.Cells(fil, "A") = sector
h2.Cells(fil + 1, "A") = "LIBRE VOL LOG"
h2.Cells(fil + 2, "A") = "LIBRE VOL 0"
h2.Cells(fil + 3, "A") = "LIBRE VOL MENSAJES"
h2.Cells(fil + 4, "A") = "% TOTAL OCUPADO EN VOLUMENES"
h2.Cells(fil + 5, "A") = "FREESPACE EN VOLUMENES"
'
vlog = Replace(vlog, "G", "")
vlog = Replace(vlog, "T", "")
v000 = Replace(v000, "G", "")
v000 = Replace(v000, "T", "")
vmen = Replace(vmen, "G", "")
vmen = Replace(vmen, "T", "")
vmen = Replace(vmen, ",", ".")
vmen = Val(vmen)
h2.Cells(fil + 1, col) = vlog
h2.Cells(fil + 2, col) = v000
h2.Cells(fil + 3, col) = vmen
h2.Cells(fil + 4, col) = vtot / wn
h2.Cells(fil + 5, col) = vvol
Next
MsgBox "CALCULOS REALIZADOS CORRECTAMENTE"
End Subsal u dos
¡Muchas Gracias!
Solo felicitarte y agradecerte enormemente la ayuda que me has prestado.
Un fuerte abrazo
Alberto
