Excel公式匯總特定貨幣的列

Question

我在Excel中有以下專欄。

我想要一個可以匯總特定貨幣單元格的Excel公式。 單元格為貨幣格式。 VBA用戶定義的函數也很好，但是首選項是Excel公式。

我正在使用Excel 2016。

編輯：單元格為貨幣格式。 前面的貨幣符號前綴不是單元格中的字符串。

Answer 1

所以我走了UDF路線-讓我知道這是否適合您。 如果您需要有關如何啟動和運行的幫助，請隨時告訴我。

UDF的語法為CurrencyVal（您用作“ sumif”的范圍，該單元格具有您要求和的格式）

因此，例如：

如果我有range（A2：A5），其中A2 =歐元，而所有其他均為美元，則要獲取美元的總和，您可以在任何單元格= 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

Answer 2

基於正則表達式的UDF。 這基於以文本形式顯示的貨幣，即單元格中有USD / EUR等。

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

---

在工作表中：

---

正則表達式：

在這里嘗試。

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

匹配[+-]?下面列表中存在的單個字符[+-]?

? 量詞-匹配0到1次，盡可能多地匹配，並根據需要返回（貪婪） +-匹配列表中的單個字符+- （區分大小寫）

JPY從字面上匹配字符JPY （區分大小寫） '

.*? 匹配任何字符（行終止符除外） *? 量詞-匹配零到無限次，次數盡可能少，根據需要擴展（延遲）

正前瞻(?=~)

斷言以下正則表達式匹配~匹配字符~字面意義（區分大小寫）

---

如果單元格中還有其他文本，則可以嘗試：

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

在這里嘗試。

Answer 3

我對Dylan的答案進行了一些修改，以進行一些自定義，以適應自己的喜好。 我將此答案發布到我自己的問題上，以備將來參考。

假設有一個范圍（A2：A5），其中A2 =歐元，而所有其他都是美元，然后要獲取美元的總和，您可以在任何單元格中輸入以下內容=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