Excel Separar valores de tipos específicos e soma-los respectivamente após a extração

[DaviH]

Olá, estou com um grande problema no qual está me fazendo quebrar a cabeça durante dias.
Na tabela logo abaixo eu tenho valores juntos em outros, e separados com ; ponto e vírgula

E só piora pois cada valor tem seu próprio tipo, por exemplo +2 For ou +2 Res

Segue o exemplo:
 

	A	B	C
1	Capacete do Guardião ; +2 For
2		Cachecol Sagrado ; +3 Des +1 For
3			Cinto de Utilidades ; +1 Res
4	Anel do Mago ; +10 Men

 

O que eu preciso é preencher outras células com a soma dos valores totais em Força (For), Resistência (Res), ...etc
 

	A	B
5	Força	+3
6	Resistência	+1
7	Destreza	0
8	Mente	+10
9	Velocidade	0

Uma das minhas melhores tentativas foi essa:
 

=MAIÚSCULA(SUBSTITUIR(ÍNDICE(CONCATENAR(SEERRO(DIVIDIRTEXTO(N4;";");"");SEERRO(DIVIDIRTEXTO(O4;";");"");SEERRO(DIVIDIRTEXTO(P4;";");"");SEERRO(DIVIDIRTEXTO(Q4;";");"");SEERRO(DIVIDIRTEXTO(N5;";");"");SEERRO(DIVIDIRTEXTO(O5;";");""););;2);" +";", +"))

 

 

Nessa fórmula eu faço a divisão de texto de cada célula, independente se está vazia ou não, e por isso já insiro um SEERRO.
Isso gera um despejo, que ao ser concatenado, permite a união dos mesmos em só uma célula. Então logo após faço um índice
limitando somente ao conteúdo pós ponto e vírgula, me retornando: +2 For +3 Des +1 For
Depois disso faço uma substituição de caracteres para ajuda em uma possível divisão de texto novamente (Que não funcionou);
então converto para caixa alta o resultado: , +2 FOR, +3 DES, +1 FOR

Eu já estou com a cabeça fritando com isso, por que não sei mais dar sequência.
Se alguma boa alma ajudar, já agradeço.

 

[DaviH]

Consegui fazer com esse código:
 

Sub VerificarAtributos()

    ' Variáveis para armazenar os totais de cada atributo
    Dim totalFor As Integer
    Dim totalRes As Integer
    Dim totalDes As Integer
    Dim totalMen As Integer
    Dim totalVel As Integer
    
    ' Intervalos das células a serem verificadas
    Dim rng As Range
    Set rng = Union(Range("N4:N20"), Range("O4:O6"), Range("O8:O13"), _
                    Range("O15:O20"), Range("P4"), Range("P6"), Range("P9"), _
                    Range("P13"), Range("Q4"), Range("Q9"), Range("Q13:V13"))

    ' Loop através de cada célula no intervalo
    Dim cell As Range
    For Each cell In rng
        If cell.Value <> "" Then
            ' Dividir a célula pelo delimitador ";"
            Dim parts() As String
            parts = Split(cell.Value, ";")
            
            Dim part As Variant
            For Each part In parts
                part = Trim(CStr(part))
                
                ' Verificar e processar cada parte por vírgula
                Dim subparts() As String
                subparts = Split(part, ",")
                
                Dim subpart As Variant
                For Each subpart In subparts
                    subpart = Trim(CStr(subpart))
                    
                    ' Verificar cada atributo e somar os valores respectivos
                    If InStr(1, subpart, "For", vbTextCompare) > 0 Then
                        totalFor = totalFor + ExtrairValor(subpart, "For")
                    ElseIf InStr(1, subpart, "Res", vbTextCompare) > 0 Then
                        totalRes = totalRes + ExtrairValor(subpart, "Res")
                    ElseIf InStr(1, subpart, "Des", vbTextCompare) > 0 Then
                        totalDes = totalDes + ExtrairValor(subpart, "Des")
                    ElseIf InStr(1, subpart, "Men", vbTextCompare) > 0 Then
                        totalMen = totalMen + ExtrairValor(subpart, "Men")
                    ElseIf InStr(1, subpart, "Vel", vbTextCompare) > 0 Then
                        totalVel = totalVel + ExtrairValor(subpart, "Vel")
                    End If
                Next subpart
                
            Next part
        End If
    Next cell

    ' Colocar os resultados nas células correspondentes
    Range("N22").Value = totalFor
    Range("N23").Value = totalRes
    Range("N24").Value = totalDes
    Range("N25").Value = totalMen
    Range("N26").Value = totalVel

End Sub

Function ExtrairValor(ByVal texto As String, ByVal atributo As String) As Integer
    ' Esta função extrai o valor numérico associado ao atributo
    Dim valor As Integer
    valor = 0
    
    ' Encontrar o início do atributo no texto
    Dim pos As Integer
    pos = InStr(1, texto, atributo, vbTextCompare)
    
    If pos > 0 Then
        ' Capturar o valor numérico antes do atributo
        Dim numero As String
        numero = Mid(texto, 1, pos - 1)
        
        ' Remover sinais de "+" ou "-" do número
        If IsNumeric(numero) Then
            valor = CInt(numero)
        End If
    End If
    
    ExtrairValor = valor
End Function