Consulta función buscar y sumar

Hola experto, antes que nada agradezco tu disposición, mi consulta es la siguiente:

Tengo una tabla con una columna de jugadores y otra con puntos de ese jugador:

Jugadores Puntos

Juan 10

Pablo 40

Y en otras celdas coloque

Jugador:

Puntos:

Donde quiero poner el nombre del jugador y los puntos para que los sume automáticamente en la tabla.

Tendría que utilizar la función Buscar para buscar el jugador en el rango de jugadores,¿ pero como puede hacer para sumar los puntos y escribirlos en el rango de puntos?

Gracias experto por tu ayuda!!!

Respuesta
1

Como no es posible hacer lo que pides a través de formulas por la sencilla razón que si modificas una, se van a actualizar todas con respecto al nuevo valor pero no te va a mantener el anterior, vamos a hacerlo con código. Ábrete el proyecto de VBA Alt +F11, inserta un módulo y pega este código:

Option Explicit
Function comprobar_player(player As Variant, ByRef i As Integer, ByRef r As Integer) As Boolean
'Importante!!!!!!
'cambia la letra de la columna de los jugadores por la real
'la fila es irrelevante por lo que elige la primera que contenga jugadores
Const c_jugador = "A2"
Dim c As Integer
'me posiciono en la primera celda donde empiezan los jugadores
Range(c_jugador).Select
r = ActiveCell.Row
c = ActiveCell.Column
i = 0
Do While UCase(Cells(r + i, c).Value) <> UCase(player) And Cells(r + i, c).Value <> ""
i = i + 1
Loop
If UCase(Cells(r + i, c).Value) = UCase(player) Then
comprobar_player = True
Else: comprobar_player = False
End If
End Function
Sub gestionar_click()
On Error Resume Next
'Importante!!!!!!
'cambia la letra de la columna de los puntos por la real
'la fila es irrelevante por lo que elige la primera que contenga puntos
Const c_puntos = "B2"
Dim i As Integer, r As Integer, c As Integer
Dim opc As Byte
Dim player As Variant, puntos As Variant
Dim resp As String
Dim temp As Single
Application.ScreenUpdating = False
jugar:
player = Application.InputBox("Introduzca el nombre del jugador a gestionar (Cancelar para salir)")
If player = False Then
Exit Sub
ElseIf player = "" Then
MsgBox "No ha introducido ningún nombre. Vuelva a intentarlo.", vbOKOnly + vbExclamation
GoTo jugar
Else:
If comprobar_player(player, i, r) = False Then
MsgBox "No existe el nombre " & UCase(player) & " en el registro. Imposible continuar.", vbOKOnly + vbExclamation
Exit Sub
End If
End If
Range(c_puntos).Select
c = ActiveCell.Column
resp = MsgBox("Jugador encontrado:" & vbCrLf & "- Nombre: " & UCase(player) & vbCrLf & "- Puntos: " & Cells(r + i, c).Value & vbCrLf & "¿Desea continuar?", vbYesNo + vbQuestion)
If resp = vbNo Then
Exit Sub
Else:
points:
puntos = Application.InputBox("Introduzca los puntos a gestionar (Cancelar para salir)")
puntos = CDbl(puntos)
If puntos = False Then
Exit Sub
ElseIf puntos = "" Then
MsgBox "No han introducido puntos. Vuelva a intentarlo.", vbOKOnly + vbExclamation
GoTo points
End If
gestión:
opc = Application.InputBox("Introduzca la opción del jugador a gestionar (Cancelar para salir)" & vbCrLf & "1.- Añadir puntos" & vbCrLf & "2.- Eliminar puntos" & vbCrLf & "3.- Salir")
Select Case opc
Case 1
temp = Cells(r + i, c).Value
resp = MsgBox("¿Desea añadir " & puntos & " punto/s a los actuales?", vbYesNo + vbQuestion)
If resp = vbYes Then
Cells(r + i, c).Value = temp + puntos
MsgBox "Se han actualizado los puntos del jugador " & UCase(player) & " y son: " & Cells(r + i, c).Value, vbOKOnly + vbInformation
Else: Exit Sub
End If
Case 2
temp = Cells(r + i, c).Value
resp = MsgBox("¿Desea eliminar " & puntos & " punto/s a los actuales?", vbYesNo + vbQuestion)
If resp = vbYes Then
Cells(r + i, c).Value = temp - puntos
MsgBox "Se han actualizado los puntos del jugador " & UCase(player) & " y son: " & Cells(r + i, c).Value, vbOKOnly + vbInformation
Else: Exit Sub
End If
Case 3
Exit Sub
Case Else
MsgBox "La opción introducida no es correcta. Inténtelo de nuevo", vbOKOnly + vbExclamation
GoTo gestión
End Select
End If
Application.ScreenUpdating = True
End Sub

Ahora en tu hoja donde tienes los nombres y sus puntos, create un botón de formulario y asígnale el sub gestión.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas