Question

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的任何内容。思考？
您可以忽略已注释掉的＆＃34; delim＆＃34;线。我试图选择在字母之间设置分隔符。它没有用，所以我只是使用空间。

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停止运行。＆＃34;新＆＃34; ＆＃34; sheet10＆＃34;和＆＃34; sheet13＆＃34;似乎不存在于VBA项目窗口中的任何地方。＆＃34;新＆＃34;工作表旁边有一个蓝色图标。

我必须将UDF中的引用更改为新的工作表名称，因为Excel已创建＆＃34; new＆＃34;床单并重新命名为我的＆＃34; old＆＃34;床单本身。不再有#VALUE错误。

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

更新＃2,1 / 2016 我在12月初将所有真实的现有工作表复制到了新工作簿截至今天，当我打开它时，这个新工作簿中的公式都是错误（#VALUE）。 Excel没有创建我上次更新中看到的不存在的工作表。上周的XLS＆amp;公式工作，我没有做任何改变。原始工作簿（pix中显示的工作表与不存在的工作表）没有#VALUE错误。两个工作簿都在同一台计算机上，并且在过去一个月内一起更新+用于比较目的。

UPDATE3,1 / 6/2016 我只是不小心移动了一个文本单元格，然后单击撤消，所有#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

更新＃1 上面更新＃1中显示的工作簿问题似乎是由于Excel自动重命名工作表名称而破坏了我的UDF。我不得不将UDF中的引用更改为新的工作表名称，因为Excel创建了“新”工作表并自行重命名了我的“旧”工作表。不再有#VALUE错误。

更新＃2：
我不知道在上面的UPDATE＃2中修复了#VALUE错误的方式或原因。建议？

创建Excel用户定义函数（UDF），可以对混合数字和文本

1 个答案: