¿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
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 SubEl 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
