0

excel中的数据示例：
COL A B C D 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

2015 年 11 月 25 日更新 #1 我发现了对我来说破坏 UDF 的原因。

Excel 2010 似乎创建了一组新的工作表并重命名了所有原始工作表，例如 Sheet10 变为 Sheet101，Sheet13 变为 Sheet131。这会导致 UDF 停止运行。除了在 VBA 项目窗口中，“新”“sheet10”和“sheet13”似乎不存在于任何地方。“新”工作表旁边有一个蓝色图标。

我不得不将 UDF 中的引用更改为新的工作表名称，因为 Excel 创建了“新”工作表并自行重命名了我的“旧”工作表。不再有 #VALUE 错误。

在此处输入图像描述 在此处输入图像描述

在此处输入图像描述

有谁知道是什么导致 Excel/VBA 创建这些不存在的工作表并重命名原始工作表？

更新 #2，2016 年 1 月 6 日我在 12 月初将所有真实的现有工作表复制到了一个新工作簿中。
截至今天，当我打开这个新工作簿中的公式时，它再次都是错误 (#VALUE)。Excel 没有创建我上次更新中看到的不存在的工作表。上周 XLS 和公式正在工作，我没有做任何更改。原始工作簿（图中显示的带有不存在的工作表的工作簿）没有#VALUE 错误。两个工作簿都在同一台计算机上，并在上个月一起更新+用于比较目的。

UPDATE3，1/6/2016 我只是不小心移动了一个文本单元格，然后单击撤消，所有#VALUE 错误都消失了，我现在有了所有正确的计算。哇。

4

1 回答 1

0

这是我最后的 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 创建了“新”工作表并自行重命名了我的“旧”工作表。不再有 #VALUE 错误。

更新#2：
我不知道在上面的更新#2 中如何或为什么修复#VALUE 错误。建议？

于 2015-07-09T15:13:56.727 回答