¿Cómo hacer una macro de una celda que cuente registros solo con VBA?

Tengo una macro donde al cambiar el nombre de la empresa que es una lista desplegable, el código del costado cambia en una hoja llamada PVS T-REGISTRO.

Quiero adicionar otro código donde en la celda B3 salga automáticamente el número de celdas con algún dato pero no puedo crear otro Private Sub Worksheet_Change(ByVal Target As Range) porque me da error.

Lo que está como comentario lo adicioné al código para que sume con la instrucción anterior pero me lanza error al borrar un registro y cambia a un número menos del total. El excel se cuelga y se cierra.

¿Cómo puedo poner esa segunda instrucción en el Worksheet_change sin que se me cuelgue la macro?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B2")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    Dim f As Range
    Set f = Sheets("Datos").Range("B:B").Find(Target.value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      Target.Offset(0, 1).value = f.Offset(0, -1)
    End If
  End If
'Dim ws As Worksheet
'Set ws = Worksheets("PVS T-REGISTRO")
'ws.Range("B3") = Application.WorksheetFunction.CountA(ws.Range("B6:B1048576"))
End Sub

1 Respuesta

Respuesta
1

El evento Change se utiliza para ejecutar un código cuando modificas una celda.

Te explico por qué se "cuelga" la macro.

Pusiste la línea:

ws.Range("B3") = Application.WorksheetFunction.CountA(ws.Range("B6:B1048576"))

Eso significa, que modificas la celda B3, como estás modificando una celda (como ya lo expliqué), entonces se activa el evento Change y entra nuevamente al código, el código modifica nuevamente la celda B3 y se activa nuevamente el código... y es por eso que entra en bucle.


Ahora te pregunto:

1. ¿Por qué lo quieres en VBA?

Puedes poner la fórmula en B3:

=CONTARA(B6:B10000)

2. ¿Quieres qué se realice el conteo cada vez que modificas la celda B2?

Si es así, utiliza lo siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B2")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    Dim f As Range
    Set f = Sheets("Datos").Range("B:B").Find(Target.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      Target.Offset(0, 1).Value = f.Offset(0, -1)
    End If
    Range("B3").Value = WorksheetFunction.CountA(Range("B6:B" & Range("B" & Rows.Count).End(3).Row))
  End If
End Sub

Hola, disculpe la demora. He probado y necesito ayuda :(

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B2")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    Dim f As Range
    Set f = Sheets("Datos").Range("B:B").Find(Target.value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      Target.Offset(0, 1).value = f.Offset(0, -1)
    End If
  End If
   Range("B3").value = WorksheetFunction.CountA(Range("B6:B" & Range("B" & Rows.Count).End(3).Row))
End Sub

El código le puse debajo del segundo IF y funcionó, sin embargo al borrar todos los registros el mínimo es 1 y no cero, recién a aprtir del 2do elemento cambia al nuemro 2 ¿por qué pasa eso?

¿Leíste con atención lo que expliqué?

El evento Change se utiliza para ejecutar un código cuando modificas una celda.

Te explico por qué se "cuelga" la macro.

Pusiste la línea:

ws.Range("B3") = Application.WorksheetFunction.CountA(ws.Range("B6:B1048576"))

Eso significa, que modificas la celda B3, como estás modificando una celda (como ya lo expliqué), entonces se activa el evento Change y entra nuevamente al código, el código modifica nuevamente la celda B3 y se activa nuevamente el código... y es por eso que entra en bucle.


1. ¿Por qué lo quieres en VBA?

Puedes poner la fórmula en B3:

=CONTARA(B6:B10000)

2. ¿Quieres qué se realice el conteo cada vez que modificas la celda B2?


Prueba esto:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B2")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    Dim f As Range
    Set f = Sheets("Datos").Range("B:B").Find(Target.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
      Target.Offset(0, 1).Value = f.Offset(0, -1)
    End If
  End If
  Dim lr As Long
  lr = Range("B" & Rows.Count).End(3).Row
  If lr < 6 Then lr = 6
  Application.EnableEvents = False
  Range("B3").Value = WorksheetFunction.CountA(Range("B6:B" & lr))
  Application.EnableEvents = True
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas