dneprcomp
Silver Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Dim strSource As String 'для исходного стринга
'объявляем динамический массив, т.к. не знаем сколько будет слов
Dim arWord() As String
'в этом массиве держим встречаемость
Dim arQuant() As Integer
Dim strTemp As String
Dim Count As Integer
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim Found As Boolean
'инициализируем динамические массивы сразу на 50 элементов(чтобы не переобъявлять слишком часто)
Y = 50
ReDim arWord(Y)
ReDim arQuant(Y)
Count = 0
strSource = 'инициализируем исходным стрингом
'по совету Troitsky добавляем пробел в конец
strSource = LTrim(strSource) & Space(1)
'крутим код, пока стринг не закончится или не будет состоять из одних пробелов
Do While Trim(strSource) <> ""
Found = False
'находим первое слово
strTemp = Left(strSource, InStr(strSource, " ") - 1)
'проверяем на наличие в массиве
For X = 0 To Y
'если дошли до пустого значения элемента массива(или первый элемент оказался пустым), то сразу присваиваем значение и увеличиваем счетчик
If arWord(X) = "" Then
arWord(X) = strTemp
arQuant(X) = arQuant(X) + 1
Found = True
Exit For
'если нашли совпадение, то только увеличиваем счетчик
ElseIf arWord(X) = strTemp Then
arQuant(X) = arQuant(X) + 1
Found = True
'прекращаем цикл, т.к. нет смысла крутить дальше
Exit For
End If
Next X
'если не нашли или не присвоили значение, значит нет свободных элементов массива. Пора переобъявить.
If Found = False Then
Y = Y + 50
'переобъявляем с сохранением значений
ReDim Preserve arWord(Y)
ReDim Preserve arQuant(Y)
'сохраняем текущий индекс переменной
X = X + 1
arWord(X) = strTemp
arQuant(X) = arQuant(X) + 1
End If
'отрезаем первое вхождение слова, используя функцию Replace
strSource = Space(1) & LTrim(Replace(strSource, strTemp, "", 1, 1, vbTextCompare))
'проверяем, встречается ли слово еще
If Trim(strSource) <> "" Then
strTemp = Space(1) & strTemp & Space(1)
Z = InStr(strSource, strTemp)
Do While Z <> 0
arQuant(X) = arQuant(X) + 1
strSource = Replace(strSource, Trim(strTemp), "", 1, 1, vbTextCompare)
Z = InStr(strSource, strTemp)
Loop
strSource = LTrim(strSource)
End If
DoEvents
Loop
strTemp = ""
For X = 0 To UBound(arWord)
If arWord(X) = "" Then
Exit For
End If
strTemp = strTemp & arWord(X) & Space(3) & arQuant(X) & vbNewLine
Next X
MsgBox strTemp
|
Всего записей: 3920 | Зарегистр. 31-03-2002 | Отправлено: 23:49 08-12-2005 | Исправлено: dneprcomp, 21:36 09-12-2005 |
|
