Пример данных в 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. Мысли?
Вы можете игнорировать закомментированные «разделительные» строки. Я пытался установить разделитель между буквами. Это не сработало, поэтому я просто использую пробел.
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, 25 ноября 2015 г. Я обнаружил, что для меня нарушает UDF.
Excel 2010, похоже, создал новый набор рабочих листов и переименовал все оригиналы, например Sheet10 становится Sheet101, Sheet13 становится Sheet131. Это приводит к прекращению работы UDF. Кажется, что «новый» «лист10» и «лист13» не существуют нигде, кроме окна проекта VBA. Рядом с «новыми» листами отображается синий значок.
Мне пришлось изменить ссылки в UDF на новые имена листов, поскольку Excel создал «новые» листы и переименовал мои «старые» листы самостоятельно. Ошибок #VALUE больше нет.
Кто-нибудь знает, что заставило Excel / VBA создать эти несуществующие листы и переименовать исходные листы?
ОБНОВЛЕНИЕ № 2, 1/6/2016 Я скопировал все настоящие существующие листы в новую книгу в начале декабря.
На сегодняшний день формулы в этой новой книге снова являются ошибками (#VALUE), когда я ее открывал. Excel не создавал несуществующие листы, как было показано в моем последнем обновлении. На прошлой неделе XLS и формулы работали, и я не внес изменений. Исходная книга (та, которая показана на рисунке с несуществующими рабочими листами) не содержит ошибок #VALUE. Обе книги находятся на одном компьютере и были обновлены вместе за последний месяц + для сравнения.
ОБНОВЛЕНИЕ 3, 1/6/2016 Я просто случайно переместил текстовую ячейку, затем нажал «Отменить», и все ошибки #VALUE исчезли, и теперь у меня есть все правильные вычисления. Какого черта.
