Страницы: 1
RSS
Функция подсчета количества указанных символов в ячейке
 
Помогите пожалуйста написать функцию. Нужно посчитать в одной ячейке поочередно количество букв М, R или T; M умножить на 7, R на 5, T на 4, а потом все сложить и прибавить 18. Формулами могу, но поскольку часто пользуюсь, хотельсь бы иметь функцию, а написать самому не получается.
Если что, есть удобная функция подсчета символов в ячейке:
Код
Function СЧЁТСИМВЛ(ТЕКСТ As String, СИМВОЛ As String) As Long
    Dim i As Long
    Dim S As Long
  
    S = 0
    For i = 1 To Len(ТЕКСТ)
        If СИМВОЛ = Mid(ТЕКСТ, i, 1) Then S = S + 1
    Next
  
    СЧЁТСИМВЛ = S
End Function
Пример прикрепляю.
 
dim284, а почему у вас где-то М и где-то М (рус)?)
Код
Function СЧЁТСИМВЛ(ТЕКСТ As String, СИМВОЛ As String) As Long
Dim i As Long, S As Long, x As Long
    If СИМВОЛ = "M" Then
        x = 7
    ElseIf СИМВОЛ = "R" Then
        x = 5
    Else
        x = 4
    End If
    S = 0
    For i = 1 To Len(ТЕКСТ)
        If СИМВОЛ = Mid(ТЕКСТ, i, 1) Then S = S + 1
    Next
    СЧЁТСИМВЛ = S * x + 18
End Function

Изменено: Mershik - 21.10.2020 11:02:01
Не бойтесь совершенства. Вам его не достичь.
 
Пардон, с M на русском я погорячился.
Чего-то здесь не хватает, не считает. А аргумент СИМВОЛ здесь наверное лишний?
 
dim284, считает что берм ячейку с текстом потом ячейку с буквой и перемножаем количество на нужное число и + 18, но Вам видимо что-то иное нужно
Изменено: Mershik - 21.10.2020 11:22:26
Не бойтесь совершенства. Вам его не достичь.
 
Не совсем то, получается опять много ячеек с расчетами. Нужно оставить только один аргумент ТЕКСТ.
 
dim284,
Код
Function СЧЁТСИМВЛ(ТЕКСТ As String) As Long
Dim i As Long, S As Long, x As Long, arr
arr = Array("M", "R", "T")
    For i = LBound(arr) To UBound(arr)
        For k = 1 To Len(ТЕКСТ)
            If arr(i) = Mid(ТЕКСТ, k, 1) Then x = x + 1
        Next k
        If arr(i) = "M" Then
            Z = x * 7
        ElseIf arr(i) = "R" Then
            Z = x * 5
        ElseIf arr(i) = "T" Then
            Z = x * 4
        End If
        S = Z + S
        x = 0
    Next i
    СЧЁТСИМВЛ = S + 18
End Function

Не бойтесь совершенства. Вам его не достичь.
 
Ищем Магнитно-Резонансную Терапию? :)
Код
k =  Len(ТЕКСТ)
Z = (k-Replace(ТЕКСТ,"M",""))*7
Z = Z + (k-Replace(ТЕКСТ,"R",""))*5
Z = Z + (k-Replace(ТЕКСТ,"T",""))*4
СЧЁТСИМВЛ = Z + 18

Если искомых символов много, загнать их в массив вместе с коэффициентами и пройтись циклом:
Код
For i = 1 To UBound(a)
     Z = Z + (k-Replace(ТЕКСТ, a(i, 1) ,""))* a(i, 2) 
Next i


P.S. Ошибка:
k - Len(Replace(...
 
vikttur,  :D  
Не бойтесь совершенства. Вам его не достичь.
 
Слушайте, ну бомба получилась! Формула считает молекулярную массу в аминокислотной последовательности:

Код
Function Молекулярная_масса(ТЕКСТ As String) As Long
Dim i As Long, S As Long, x As Long, arr
arr = Array("A", "C", "D", "E", "F", "G", "H", "I", "K", "L", "M", "N", "P", "Q", "R", "S", "T", "V", "W", "Y")
    For i = LBound(arr) To UBound(arr)
        For k = 1 To Len(ТЕКСТ)
            If arr(i) = Mid(ТЕКСТ, k, 1) Then x = x + 1
        Next k
        If arr(i) = "A" Then
        Z = x * 71.0788
        ElseIf arr(i) = "C" Then Z = x * 103.1388
        ElseIf arr(i) = "D" Then Z = x * 115.0886
        ElseIf arr(i) = "E" Then Z = x * 129.1155
        ElseIf arr(i) = "F" Then Z = x * 147.1766
        ElseIf arr(i) = "G" Then Z = x * 57.0519
        ElseIf arr(i) = "H" Then Z = x * 137.1411
        ElseIf arr(i) = "I" Then Z = x * 113.1594
        ElseIf arr(i) = "K" Then Z = x * 128.1741
        ElseIf arr(i) = "L" Then Z = x * 113.1594
        ElseIf arr(i) = "M" Then Z = x * 131.1926
        ElseIf arr(i) = "N" Then Z = x * 114.1038
        ElseIf arr(i) = "P" Then Z = x * 97.1167
        ElseIf arr(i) = "Q" Then Z = x * 128.1307
        ElseIf arr(i) = "R" Then Z = x * 156.1875
        ElseIf arr(i) = "S" Then Z = x * 87.0782
        ElseIf arr(i) = "T" Then Z = x * 101.1051
        ElseIf arr(i) = "V" Then Z = x * 99.1326
        ElseIf arr(i) = "W" Then Z = x * 186.2132
        ElseIf arr(i) = "Y" Then Z = x * 163.176
        End If
        S = Z + S
        x = 0
    Next i
    Молекулярная_масса = S + 18' плюс молекула воды
End Function

Единственное, она округляет до целого значения, а в идеале 4 знака после запятой. Ну до бог с ней.

Спасибо!

Изменено: dim284 - 21.10.2020 12:58:25
 
dim284, попробуйте  dim z as Double не поможет  
Изменено: Mershik - 21.10.2020 13:01:42
Не бойтесь совершенства. Вам его не достичь.
 
Код
Function Молекулярная_масса(ТЕКСТ As String) As Double
Dim i As Integer, S As Double
Static arr
On Error Resume Next
If arr Is Empty Then _
    arr = Array(71.0788, 103.1388, 115.0886, 129.1155, 147.1766, 57.0519, 137.1411, 113.1594, 128.1741, _
        113.1594, 131.1926, 114.1038, 97.1167, 128.1307, 156.1875, 87.0782, 101.1051, 99.1326, 186.2132, 163.176)
    For i = 1 To Len(ТЕКСТ)
        S = S + arr(Asc(UCase(Mid(ТЕКСТ, i, 1))) - 65 + LBound(arr))
    Next
    Молекулярная_масса = Round(S + 18, 4) ' плюс молекула воды
End Function


Апдэйт : в массиве нужно упорядочить значения в соответвии с алфавитом латинским (A-Z) и если есть пропуски добавить нули.
Изменено: БМВ - 21.10.2020 13:38:59
По вопросам из тем форума, личку не читаю.
 
Миша, в массив нулей накидать - буквы не все.
 
Цитата
vikttur написал:
буквы не все.
да, и порядок не тот, но думаю с этим то ТС справится. Там я и так уже свой лимит на 2 строки перебрал :-)
По вопросам из тем форума, личку не читаю.
 
Лентяй
 
Off
Цитата
vikttur написал:
Лентяй
просто между постами еще и работаю и  ....
По вопросам из тем форума, личку не читаю.
 
Знал, что люди постят перед большими церковными праздниками, но пост, смысл которого - не работать - это сила! :)
 
Off
Цитата
vikttur написал:
что люди постят перед большими церковными праздниками
Не постят они, а постятся  :D . А вот остальное все правильно  :D
Изменено: БМВ - 21.10.2020 14:52:11
По вопросам из тем форума, личку не читаю.
 
БМВ работает Ваш макрос, работает! Вот он с нулями. Причем 4 знака после запятой выдает.
Код
Function Молекулярная_масса(ТЕКСТ As String) As Double
Dim i As Integer, S As Double
Static arr
On Error Resume Next
If arr Is Empty Then _
    arr = Array(71.0788, 0, 103.1388, 115.0886, 129.1155, 147.1766, 57.0519, 137.1411, 113.1594, 0, 128.1741, _
        113.1594, 131.1926, 114.1038, 0, 97.1167, 128.1307, 156.1875, 87.0782, 101.1051, 0, 99.1326, 186.2132, 0, 163.176, 0)
    For i = 1 To Len(ТЕКСТ)
        S = S + arr(Asc(UCase(Mid(ТЕКСТ, i, 1))) - 65 + LBound(arr))
    Next
    Молекулярная_масса = Round(S + 18, 4) ' плюс молекула воды
End Function

У Mershik было все понятно - буква, к ней значение. А тут точно нечистая сила руку приложила :)
Как тут кто-то писал - утащил функцию к себе в амбар.
Страницы: 1
Наверх