創建可以對混合數字和文本求和的Excel用戶定義函數（UDF）

Question

Excel中的數據示例：
COL ABCD F..... 1 SL..... 2 SL8 AL4 CD3 CN5 CD4 AL8

我根據單元格中的字母標識符有條件地進行總結。 將UDF輸入到單元格（F2） =SumDigByLTR2(A2:C2,F1) ，其中F1-I1是求和的條件（字母，SL，AL等）。 結果應為：
SL=8 AL=12 CD=7 CN=5

我在VBA中創建了此用戶定義的函數（如下）。 我修改了一些在網上找到的代碼。 它起初工作，然后神秘地停止工作。 我不記得更改任何XLS或VBA。 有什么想法嗎？
您可以忽略注釋掉的“ delim”行。 我試圖有一個選項來設置字母之間的分隔符。 它沒有用，所以我只用一個空格。

Option Explicit
Function SumDigByLTR2(rg As Range, ltr As String) As Double
Dim c As Range   'c = a cell
Dim delimiter As String
Dim InStrResult As Long  'returns the position of "ltr" in the cell e.g. abc34, if ltr="c", then Instr() = 3
Dim MidResult As Long
Dim numltr As Integer 'number of characters in the critera, i.e. AL or A
'Dim delim_text As String 'this will identify the user preferred demlimiter text.
Dim StartPos As Integer  'position of ltr + number of characters in the critera, i.e. AL or A
Dim DelimPos As Integer  'position of delimiter after "ltr"
Dim numlen As Integer  'returns length of the desired numbers i.e. "3" =1 or "10" =2

For Each c In rg
'delimiter = Sheet7.Range("O8").Value
    InStrResult = InStr(1, c.Text, ltr, vbTextCompare)
    If InStr(1, c.Text, ltr, vbTextCompare) > 0 Then

        StartPos = InStrResult + Len(ltr)
        DelimPos = InStr(InStrResult, c.Text, " ") 'Sheet7.Cells(8, 15).Value)  '"O"=15

            If DelimPos = 0 Then
               MidResult = Right(c.Text, Len(c.Text) - StartPos + 1)  '"+1" because if cell=al3; starpos will = 3 & len(cell)=3; therefore   Len-startpos=0
            Else
               numlen = DelimPos - StartPos + 1
               MidResult = Mid(c.Text, StartPos, numlen)
            End If

        SumDigByLTR2 = SumDigByLTR2 + MidResult

    End If
Next c
End Function


'Original
'http://www.pcreview.co.uk/forums/excel-extract-and-sum-numerals-mixed-text-numeral-cell-range-t937450.html

'Option Explicit
'Function SumDigByLtr(rg As Range, ltr As String) As Double

'Dim c As Range

'For Each c In rg
'If InStr(1, c.Text, ltr) > 0 Then
'SumDigByLtr = SumDigByLtr + Replace(c.Text, ltr, "")

'End If
'Next c
'End Function

更新＃1，2015年11月25日，我發現了破壞我的UDF的原因。

Excel 2010似乎已經創建了一組新的工作表並將所有原始文件重命名，例如Sheet10變成Sheet101，Sheet13變成Sheet131。 這將導致UDF停止運行。 “新”“ sheet10”和“ sheet13”似乎不在VBA項目窗口中的任何位置。 “新”工作表旁邊有一個藍色圖標。

由於Excel創建了“新”工作表並自行重命名了“舊”工作表，因此我不得不將UDF中的引用更改為新的工作表名稱。 沒有更多的#VALUE錯誤。

有誰知道是什么原因導致Excel / VBA創建這些不存在的工作表並重命名原始工作表？

更新＃2，2016年1月6日我在12月初將所有真實的現有工作表復制到了新的工作簿中。
從今天起，當我打開它時，此新工作簿中的公式再次都是錯誤（#VALUE）。 Excel尚未創建不存在的工作表，如我上次更新所示。 上周XLS和公式有效，我沒有進行任何更改。 原始工作簿（顯示在pix w /不存在的工作表中）沒有#VALUE錯誤。 兩個工作簿都在同一台計算機上，並且在過去一個月中已進行了更新，以進行比較。

UPDATE3，2016年1月6日，我只是不小心移動了一個文本單元格，然后單擊“撤消”，所有#VALUE錯誤都消失了，現在我進行了所有正確的計算。 WTF。

Answer 1

這是我最后的UDF。

Option Explicit
Function Sumbytext(rg As Range, ltr As String) As Double
'Similar to Excel SumIf, except that text can be in the cell with the number.
'That text ("ltr") can identify the number, as a condition to sum.
'e.g. Cell1 (D5 T8 Y3), Cell2(D3 A2), Cell3 (T8) >>> Sums: D=8 T=16 Y=3 A=2

Dim c As Range   'c = a cell
Dim InStrResult As Integer  'returns the position of "ltr" in the cell 
e.g. abc34, if ltr="c", then Instr() = 3
Dim MidResult As Double
Dim numltr As Integer 'number of characters in the critera, i.e. AL or A
Dim StartPos As Integer  'position of ltr + number of characters in the critera, i.e. AL or A
Dim DelimPos As Integer  'position of delimiter after "ltr"
Dim numlen As Integer  'returns length of the desired numbers i.e. "3" =1 or "10" =2
Dim Abbr As Range  'abbreviation of holiday - this is displayed on the calendar
Dim rgAbbr As Range  'the list of abbreviations corresponding to the list of holidays

Set rgAbbr = Worksheets("Holidays").Range("List_HolAbbr")

For Each c In rg
  For Each Abbr In rgAbbr
    If UCase(c) = UCase(Abbr) Then GoTo skipcell   'skip cell if the holiday names are in the cell >> 'Labor day' gives an error because the function looking for a cell containing "LA".  Therefore exclude "Labor".
    Next Abbr
     If InStr(1, c.Text, UCase("OCT"), vbTextCompare) > 0 Then GoTo skipcell 'skip cell if it inscludes "Oct".  >> results in error due to the "CT" being used as "ltr".
     InStrResult = InStr(1, c.Text, ltr, vbTextCompare)
     If InStrResult > 0 Then
        StartPos = InStrResult + Len(ltr)
        DelimPos = InStr(InStrResult, c.Text, " ")

        If DelimPos = 0 Then
          MidResult = Right(c.Text, Len(c.Text) - StartPos + 1) '"+1" because if cell=al3; starpos will = 3 & len(cell)=3; therefore Len-startpos=0
        Else
      numlen = DelimPos - StartPos + 1
      MidResult = Mid(c.Text, StartPos, numlen)
        End If

        Sumbytext = Sumbytext + MidResult

    End If
skipcell:
Next c
End Function

UPDATE＃1上面UPDATE＃1中顯示的工作簿問題似乎是由於UDF由Excel自動重命名而破壞了我的UDF。 由於Excel創建了“新”工作表並自行重命名了“舊”工作表，因此我不得不將UDF中的引用更改為新的工作表名稱。 沒有更多的#VALUE錯誤。

更新＃2：
我不知道如何或為什么在上面的UPDATE＃2中修復了#VALUE錯誤。 有什么建議嗎？