Macro para eliminar ceros en un varias de columnas

Alguien me puede apoyar con la siguiente macro por favor, que en un rango de columnas por ejemplo de A:F busque ceros y los elimine y a su vez, elimine el contenido de la celda que se encuentra a lado izquierdo, por ejemplo si en B8 hay un cero, elimine el cero y tambien limpie la celda A8, necesito que haga el recorrido en un rago de columnas hasta llegar a la ultima fila con valores.

3 Respuestas

Respuesta
2

.24.05.17

Buenas noches, Noel

La siguiente rutina borra la celda que tenga un cero y la que tenga a la izquierda.

Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:

Sub SacaCeros()
'---- Variables modificables ----
'=== NOEL, modifica estos datos de acuerdo a tu proyecto:
    iniRango = "A3"
    Buscar = 0 'valor a buscar
'---- fin Variables
'
' VBA coding by FeJoAl
'
'---- inicio de rutina:
'  
Dim LaCelda As Range
Elrango = Range(iniRango).CurrentRegion.Address
For Each LaCelda In ActiveSheet.Range(Elrango)
    If LaCelda.Value = 0 Then
        LaCelda.ClearContents
        If LaCelda.Column > 1 Then LaCelda.Offset(0, -1).ClearContents
        cont = cont + 1
    End If
Next
ElMensaje = IIf(cont = 0, "NO SE BORRO CELDA ALGUNA, porque" & Chr(10) & "no se encontró " & Buscar & " en esta hoja", "Se borraron: " & cont & " cero" & IIf(cont > 1, "s", "") & Chr(10) & "y su celda a la izquierda")
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Notarás al principio del código unas variables que podrás modificar en caso de que necesitaras cambiarlas. Basta indicarle en qué celda inicia tu rango de datos.

Dado que se trata de una rutina de eliminación, te recomiendo que la pruebes en una copia de tu hoja.

Coméntame si mi solución resuelve lo que buscas -y, en tal caso, agradeceré que califiques mi contribución con el botón de opción de abajo- o escríbeme de nuevo aquí, si necesitas más apoyo con esto.

Un saludo

Fernando

.

.

Hola,

Entiendo que hace poco que visitas este sitio.
Una vez que recibiste la respuesta deberías asignarle una valorización con el botón de opciones (Excelente, Util, Etc) que está al pie, para que quede finalizada. En caso de que tuvieras alguna duda, pregúntame de nuevo.

Cordialmente,
Fer

.

.

¡Gracias!

Hola antes que nada gracias por tu apoyo, estoy checando la macro efectivamente borra los ceros y la celda de la izquierda pero me marca un error al estar haciendo el recorrido, le di clic en depurar y me señala la parte del código que dice LaCelda. ¿ClearContents sabrás a que se debe? Gracias de antemano

.

Buenas, Noel

La instrucción LaCelda. ClearContents borra el contenido de cada celda de un rango si esta fuese igual a cero.

Por lo tanto, si lo hace para otras celdas, habría que ver qué características tiene esa celda en particular cuando se detiene. Si conocer tu archivo podría arriesgar que sea una celda combinada o, tal vez, protegida.

Al revisar tu planilla, ten en cuenta que la rutina no "vá" físicamente a cada celda sino que las evalúa remotamente.

Controla la celda que NO haya borrado y verifica cómo es, luego me comentas si descubriste algo.

Abrazo

Fer

.

.

De curioso, ¿por qué están valorizadas las otras respuestas posteriores (ambas con Excelente) y la mía no?

Saludos

Fer

.

¡Gracias! Hola buenas tardes honestamente no me había percatado de que había dos calificaciones y bueno para mi la manita arriba era excelente gracias por decirme así ya se que hay dos calificaciones por cierto las 3 respuestas me sirvieron a la perfección

Respuesta
2

Este ejemplo rellena con ceros te aportara algo más. Solo debes usar comando delete

https://www.youtube.com/watch?v=uiVRPrzP-5k&list=PLdK9H5dMIfQgtHDNFFm_AV6HUKYpUjrPx&index=15 

Respuesta
1

Noel en el video explico el funcionamiento de la aplicación

https://www.youtube.com/watch?v=j9J8V4IwFLE 

y el código es el siguiente.

Dim i As Long
Dim j As Integer
j = 2

For j = 2 To 10
   For i = 1 To 10
     If Cells(i, j) = "0" Then
      Cells(i, j) = ""
      Cells(i, j - 1) = ""
     End If
  Next i
Next j

Éxitos!

¡Gracias! Excelente video me sirvió a la perfección gracias amigo

De nada Noel, me alegra de que le hubiera gustado el ejercicio.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas