Ayuda con macro con columna con decimales
Hola Dam, necesito de tu ayuda nuevamente. Necesito que la columna "D" cuyos números contengan decimales, me los deje en 2 (0.00)
Sub Planilla_Gral_MI()
Set hactual = Sheets(3)
Dim xfecha
xfecha = InputBox("Ingrese fecha a procesar en formato mm/aaaa:")
Set hdest = Sheets.Add
ActiveSheet.Name = "Planilla_gral_MI"
hactual.Select
ufila = Range("A" & Rows.Count).End(xlUp).Row
ucol = ActiveCell.SpecialCells(xlLastCell).Column
hdest.Columns("C").NumberFormat = "mm\/yyyy"
hdest.Columns("D").NumberFormat = "0.00" <-- (pensé en dejarlo asi pero no quiero
toda la columna "D2" con decimales, solo necesito los datos que aparecen con
decimales que los reduzca a 2 (0.00)
j = 1
For i = 6 To ufila
If Cells(i, 2) <> "" Then
For k = 8 To ucol
If IsNumeric(hactual.Cells(i, 2)) And _
hactual.Cells(4, k) <> "" And _
hactual.Cells(i, 6) = "MI" Then
hdest.Cells(j, 1) = "'" & hactual.Cells(i, "B")
hdest.Cells(j, 2) = "'" & hactual.Cells(4, k)
hdest.Cells(j, 3) = xfecha
If hactual.Cells(i, k) = "" _
Or Not IsNumeric(hactual.Cells(i, k)) Then
hdest.Cells(j, 4) = 0
Else
hdest.Cells(j, 4) = hactual.Cells(i, k)
End If
j = j + 1
End If
Next
End If
Next
hdest.Select
MsgBox "Planilla MI generada correctamente..."
End sub
1 respuesta
Respuesta de Dante Amor
1
Cambia esta línea
hdest.Columns("D").NumberFormat = "0.00"Por estas
hdest.select
For i = 2 To hdest.Range("D" & Rows.Count).End(xlUp).Row
If hdest.Cells(i, "D") - Int(hdest.Cells(i, "D")) = 0 Then
hdest.Cells(i, "D").Select
Selection.NumberFormat = "0"
Else
hdest.Cells(i, "D") = Format(hdest.Cells(i, "D"), "0.00")
End If
Next
hactual.SelectSaludos.Dam
Si es lo que necesitas.
No hay ningún cambio, en la columna "D" siguen apareciendo los números decimales.
Te adjunto los archivos excel del Macro y de la planilla de sueldos en la cual se aplica el macro, para que veas el resultado que me da.
planilla de sueldos gral:
http://dl.dropbox.com/u/31683777/PLANILLA%20SUELDOS%20DICIEMBRE%202012.xls
Macro planilla gral:
http://dl.dropbox.com/u/31683777/MACRO%20PLANILLA%20GRAL.xls
Seguro no hace nada, porque la hoja destino está vacía, pasé las líneas al final y ya funciona, esta sería la macro:
Sub Planilla_Gral_MI()
Set hactual = Sheets(3)
Dim xfecha
xfecha = InputBox("Ingrese fecha a procesar en formato mm/aaaa")
Set hdest = Sheets.Add
ActiveSheet.Name = "Planilla_gral_MI"
hactual.Select
ufila = Range("A" & Rows.Count).End(xlUp).Row
ucol = ActiveCell.SpecialCells(xlLastCell).Column
hdest.Columns("C").NumberFormat = "mm\/yyyy"
hactual.Select
j = 1
For i = 6 To ufila
If Cells(i, 2) <> "" Then
For k = 8 To ucol
If IsNumeric(hactual.Cells(i, 2)) And _
hactual.Cells(4, k) <> "" And _
hactual.Cells(i, 6) = "MI" Then
hdest.Cells(j, 1) = "'" & hactual.Cells(i, "B")
hdest.Cells(j, 2) = "'" & hactual.Cells(4, k)
hdest.Cells(j, 3) = xfecha
If hactual.Cells(i, k) = "" _
Or Not IsNumeric(hactual.Cells(i, k)) Then
hdest.Cells(j, 4) = 0
Else
hdest.Cells(j, 4) = hactual.Cells(i, k)
End If
j = j + 1
End If
Next
End If
Next
hdest.Select
For i = 2 To hdest.Range("D" & Rows.Count).End(xlUp).Row
If hdest.Cells(i, "D") - Int(hdest.Cells(i, "D")) = 0 Then
hdest.Cells(i, "D").Select
Selection.NumberFormat = "0"
Else
hdest.Cells(i, "D") = Format(hdest.Cells(i, "D"), "0.00")
End If
Next
MsgBox "Planilla MI generada correctamente..."
ruta = ThisWorkbook.Path
nbre = "Planilla_gral_MI"
ActiveSheet.Copy
Application.DisplayAlerts = False
Set wb = ActiveWorkbook
On Error Resume Next
With wb
.SaveAs ruta & "\" & nbre & ".xls"
.Close True
End With
Set wb = Nothing
ActiveSheet.Delete
Application.DisplayAlerts = False
'Sheets("Hoja1").Select
End Sub Saludos.Dam
Si es lo que necesitas.
