Как подсчитать общее количество указанных 1000 слов в ячейке и сделать то же самое для других ячеек, используя VBA?

Question

Как подсчитать общее количество «alt» и «first», появившихся в ячейке, и сделать то же самое для других ячеек, игнорируя при этом пустые ячейки? Например, если ячейка имеет first, first, alt, first, first, first, она должна дать мне firstcounter = 5 (где firstcounter - общее количество для first) и altcounter = 1 (altcounter - общее количество для alt). После этого я могу использовать найденные значения firstcounter и altcounter, чтобы объединить их в строку, как показано в столбце B в виде «first-» & firstcounter, «alt -» & altcounter.

Dim ia As Long
Dim lastrow2 As Long
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets(1)
lastrow2 = ws1.Range("A" & ws1.Rows.count).End(xlUp).Row
For ia = 2 To lastrow2
  Dim arr() As Variant
    ' Split the string to an array
arr = Split(ws1.Cells(ia, "A"), ",").Value
'what should i do after split

Answer 1

Введите следующее в модуль кода ...

Function CountWords$(r)
    Dim a&, f&, w
    For Each w In Split(r, ",")
        If w = "alt" Then a = a + 1
        If w = "first" Then f = f + 1
    Next
    If (a + f) Then CountWords = "first-" & f & ",alt-" & a
End Function

Затем в ячейку B2 введите следующую формулу:

=CountWords(A2)

Теперь скопируйте его вниз, насколько вам нужно .

---

Обновление

Чтобы использовать вышеуказанную функцию из VBA без ввода формул в таблицу, вы можете сделать это следующим образом ...

Sub Cena()
    Dim i&, v
    With [a2:a8]
        v = .Value2
        For i = 1 To UBound(v)
            v(i, 1) = CountWords(v(i, 1))
        Next
        .Offset(, 1) = v
    End With
End Sub

Function CountWords$(r)
    Dim a&, f&, w
    For Each w In Split(r, ",")
        If w = "alt" Then a = a + 1
        If w = "first" Then f = f + 1
    Next
    If (a + f) Then CountWords = "first-" & f & ",alt-" & a
End Function

---

Обновление # 2

В ответ на ваши вопросы в комментариях вы можете использовать этот вариант вместо ...

Sub Cena()
    Dim i&, v
    With [a2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
        v = .Value2
        For i = 1 To UBound(v)
            v(i, 1) = CountWords(v(i, 1))
        Next
        .Cells = v
    End With
End Sub

Function CountWords$(r)
    Dim a&, f&, w
    For Each w In Split(r, ",")
        If w = "alt" Then a = a + 1
        If w = "first" Then f = f + 1
    Next
    If (a + f) Then CountWords = "first-" & f & ",alt-" & a
End Function

Answer 2

Чтобы сделать это независимым от слов alt и first и whitespaces в строке, я бы использовал следующие функции

Option Explicit

'Add a reference to Microsoft VBScript Regular Expressions 5.5
Public Function RemoveWhiteSpace(target As String) As String
    With New RegExp
        .Pattern = "\s"
        .MultiLine = True
        .Global = True
        RemoveWhiteSpace = .Replace(target, vbNullString)
    End With
End Function

'Add a reference to Microsoft Scripting Runtime
Function CountWordsA(rg As Range) As String

    On Error GoTo EH

    Dim dict As Dictionary
    Set dict = New Dictionary

    Dim vDat As Variant
    vDat = RemoveWhiteSpace(rg.Value)
    vDat = Split(vDat, ",")


    Dim i As Long
    For i = LBound(vDat) To UBound(vDat)
        If dict.Exists(vDat(i)) Then
            dict(vDat(i)) = dict(vDat(i)) + 1
        Else
            dict.Add vDat(i), 1
        End If
    Next i


    Dim vKey As Variant
    ReDim vDat(1 To dict.Count)
    i = 1
    For Each vKey In dict.Keys
        vDat(i) = vKey & "-" & dict(vKey)
        i = i + 1
    Next vKey

    CountWordsA = Join(vDat, ",")

    Exit Function

EH:
    CountWordsA = ""

End Function

Sub TestIt()

    Dim rg As Range
    Set rg = Range("A2:A8")
    Dim sngCell As Range

    For Each sngCell In rg
        sngCell.Offset(, 1) = CountWordsA(sngCell)
    Next sngCell
End Sub

Подробнее о словарях и регулярных выражениях

Answer 3

Альтернативное использование Filter() функции

Это демонстрирует использование функции Filter() для подсчета слов с помощью функции UBound():

Функция CountTerms() (используется также в формулах)

Function CountTerms(ByVal WordList As String, Optional TermList As String = "first,alt", Optional DELIM As String = ",") As String
'Purpose: count found terms in wordlist and return result as list
    '[1] assign lists to arrays
    Dim words, terms
    words = Split(WordList, DELIM): terms = Split(TermList, DELIM)

    '[2] count filtered search terms
    Dim i As Long
    For i = 0 To UBound(terms)
        terms(i) = terms(i) & "-" & UBound(Filter(words, terms(i), True, vbTextCompare)) + 1
    Next i
    '[3] return terms as joined list, e.g. "first-5,alt-1"
    CountTerms = Join(terms, ",")
End Function

Пример вызова (из-за комментариев) и функция справки getRange()

Для того, чтобы l oop во всем диапазоне и замените исходные данные списком результатов:

Sub ExampleCall()
    '[1] get range data assigning them to variant temporary array
    Dim rng As Range, tmp
    Set rng = getRange(Sheet1, tmp)       ' << change to sheet's Code(Name)

    '[2] loop through array values and get counts
    Dim i As Long
    For i = 1 To UBound(tmp)
        tmp(i, 1) = CountTerms(tmp(i, 1))
    Next i
    '[3] write to target (here: overwriting due to comment)
    rng.Offset(ColumnOffset:=0) = tmp

End Sub

Function getRange(mySheet As Worksheet, tmp) As Range
'Purpose: assign current column A:A data to referenced tmp array
With mySheet
    Set getRange = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    tmp = getRange          ' assign range data to referenced tmp array
End With
End Function