Tengo la siguiente columna en Excel.

enter image description here

Me gustaría tener una fórmula de Excel que pueda resumir celdas de monedas específicas. Las celdas están en formato de monedas. La función definida por el usuario de VBA también está bien, pero la preferencia es una fórmula de Excel.

Estoy usando Excel 2016.

EDITAR: las celdas están en formato de moneda. El prefijo del símbolo de moneda en el frente no es una cadena en la celda.

2
user781486 10 sep. 2018 a las 05:52

3 respuestas

La mejor respuesta

Así que tomé la ruta UDF, avíseme si esto funciona para usted. Si necesita ayuda sobre cómo poner esto en funcionamiento, no dude en hacérmelo saber.

La sintaxis para el UDF es CurrencyVal (Rango que está utilizando como "suma", una celda con el formato que desea sumar)

Así, por ejemplo:

Si tengo un rango (A2: A5) donde A2 = Euros, y todo lo demás es USD, para obtener la suma de USD ingrese lo siguiente en cualquier celda = CurrencyVal (A2: A5, A3).

Option Explicit
Function CurrencyVal(SumCellRange As Range, CurrencySumCell As Range) As Integer

Dim Cell As Variant
Dim SumRange As Integer

For Each Cell In SumCellRange
    If Cell.NumberFormat = CurrencySumCell.NumberFormat Then
        SumRange = SumRange + Cell
    End If
Next Cell


CurrencyVal = SumRange


End Function
1
Dylan L 10 sep. 2018 a las 03:09

Hice algunas modificaciones a la respuesta de Dylan para hacer algunas personalizaciones para satisfacer mis propias preferencias. Publico esta respuesta a mi propia pregunta para referencia futura.

Supongamos que hay un rango (A2: A5) donde A2 = Euros, y todo lo demás es USD, para obtener la suma de USD, ingresaría lo siguiente en cualquier celda =GetCurrencySum(A2:A5, "[$USD] #,##0.00").

Function GetCurrencySum(SumCellRange As Range, CurrencyFormat As String) As Single
    On Error GoTo errorhd
    Dim Cell As Variant
    Dim SumRange As Single

    SumRange = 0
    For Each Cell In SumCellRange
        If Cell.NumberFormat = CurrencyFormat Then
            SumRange = SumRange + Cell
        End If
    Next Cell    

    GetCurrencySum = SumRange
    Exit Function
errorhd:
    MsgBox Err.Source & "-->" & Err.Description, , "CurrencyVal"
End Function
1
user781486 11 sep. 2018 a las 14:21

Un UDF basado en expresiones regulares. Esto se basa en la moneda presente como texto, es decir, tiene USD / EUR, etc. en la celda.

Option Explicit

Public Function GetCurrencySum(ByVal rng As Range, ByVal aCurrency As String) As Variant
    Dim inputString As String, arr()
    If rng.Columns.Count > 1 Then
        GetCurrencySum = CVErr(xlErrNA)
        Exit Function
    End If

    Select Case rng.Count
    Case 1
        ReDim arr(0): arr(0) = rng.Value
    Case Else
        arr = rng.Value
    End Select

    inputString = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, 1)), "~") & "~"

    Dim matches As Object, match As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "[+-]?" & aCurrency & ".*?(?=~)"
        On Error GoTo errhand:
        If .TEST(inputString) Then
            Set matches = .Execute(inputString)
            For Each match In matches
                 GetCurrencySum = GetCurrencySum + CDbl(Replace$(match, aCurrency, vbNullString))
            Next
            Exit Function
        End If
        GetCurrencySum = 0
        Exit Function
    End With
errhand:
    GetCurrencySum = CVErr(xlErrNA)
End Function

En hoja:

enter image description here


Regex:

Pruébelo aquí.

[+-]?JPY.*?(?=~)
/
gm

Coincide con un solo personaje presente en la lista a continuación [+-]?

Cuantificador ?: coincide entre cero y una vez, tantas veces como sea posible, devolviendo según sea necesario (codicioso) +- coincide con un solo carácter en la lista +- (distingue entre mayúsculas y minúsculas)

JPY coincide con los caracteres JPY literalmente (distingue entre mayúsculas y minúsculas) '

.*? coincide con cualquier carácter (excepto los terminadores de línea) Cuantificador *?: coincide entre cero e ilimitado veces, el menor número posible, expandiéndose según sea necesario (perezoso)

Lookahead positivo (?=~)

Afirma que la expresión regular a continuación coincide ~ coincide con el carácter ~ literalmente (distingue entre mayúsculas y minúsculas)


Si hay otro texto en la celda, puede intentar:

Public Function GetCurrencySum(ByVal rng As Range, ByVal aCurrency As String) As Variant
    Dim inputString As String, arr()
    If rng.Columns.Count > 1 Then
        GetCurrencySum = CVErr(xlErrNA)
        Exit Function
    End If

    Select Case rng.Count
    Case 1
        ReDim arr(0): arr(0) = rng.Value
    Case Else
        arr = rng.Value
    End Select

    inputString = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, 1)), "~") & "~"

    Dim matches As Object, match As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "[\-\+]?" & aCurrency & "\s[\d,.]+"
        On Error GoTo errhand:
        If .test(inputString) Then
            Set matches = .Execute(inputString)
            For Each match In matches
                  GetCurrencySum = GetCurrencySum + CDbl(Replace$(Replace$(match, aCurrency, vbNullString), "~", vbNullString))
            Next
            Exit Function
        End If
        GetCurrencySum = 0
        Exit Function
    End With
errhand:
    GetCurrencySum = CVErr(xlErrNA)
End Function

Pruébelo aquí.

1
QHarr 10 sep. 2018 a las 13:00