Подсчет букв и пробелов

[zip111]

Уважаемые, помогите!

Пишу контрольную, а в программировании не силен!

Задача такая: написать приложение которое подсчитывает количество символов и пробелов в заданном ряде. Написать нужно в Microsoft Excel редакторе Visual Basic.

Спасибо заранаее!

[BasiС]

Думаю, подробно врядли кто расписывать будет. Попробую описать, как бы я это сделал в общих чертах

Код: Выделить всё

Public Sub Подсчёт()
Dim row As String 'Ряд, который мы анализируем
row = "Задача такая: написать приложение которое подсчитывает количество символов и пробелов в заданном ряде."

MsgBox Count(row, "а") 'Количество букв "а" в анализируемом ряде
MsgBox Count(row, " ") 'Количество пробелов в анализируемом ряде

End Sub

Public Function Count(str As String, spl As String) As Integer
Count = Len(str) - Len(Replace(str, spl, ""))
End Function

[Oxygen]

2 BasiC, И это работает?

Если я правильно поняла вопрос, то нужно посчитать кол-во пробелов, и всех остальных символов. Но на всякий случай кидаю 2 варианта, второй для подсчета разных символов.

Код: Выделить всё

Dim b(255)
Private Sub Form_Load()

'Первая часть считает общее количество символов и пробелов

a$ = InputBox("Введите текст для анализа")
i = 0
j = 0
For k = 1 To Len(a$)
If Mid$(a$, k, 1) <> " " Then i = i + 1 Else j = j + 1
Next
MsgBox ("Количество пробелов = " & j)
MsgBox ("Количество остальных символов = " & i)

'Вторая часть считает количество разных символов. Результаты выводит в файл.
For k = 1 To Len(a$)
b(Asc(Mid$(a$, k, 1))) = b(Asc(Mid$(a$, k, 1))) + 1
Next
Open "c:\output.txt" For Output As #1
For k = 1 To 255
If b(k) <> 0 Then
Print #1, Chr$(k) & "=" & b(k)
End If
Next
Close
End
End Sub


[Konst_One]

Oxygen
что-то у тебя второе дыхание открылось этой весной
даже в блоге своем целую дисскусию начала

[Nicky]

Код: Выделить всё

MsgBox ("Количество пробелов = " & j)
MsgBox ("Количество остальных символов = " & i)


Количество пробелов + Количество остальных символов = Длина строки => можно считать что-то одно

[Oxygen]

Код: Выделить всё

MsgBox ("Количество пробелов = " & j)
MsgBox ("Количество остальных символов = " & i)


Количество пробелов + Количество остальных символов = Длина строки => можно считать что-то одно

В производительности разницы особо никакой нету. А это для особо одаренных.

[Nicky]

В производительности разницы особо никакой нету. А это для особо одаренных.

Дело не в производительности

[BasiС]

2Oxygen
Конечно работает =)))

Думаю, оба способа имеют право нажизнь =)
Какой предпочтительней - вопрос к zip111

[Oxygen]

Cтранно, что работает.... У меня ругается на слово Count - оно по-моему, зарезервированно....

Кстати, если текст очень большой (заметно от 20 Кб), то большая разница в производительности. Сообственно, выкладываю для сравнения тест. В начале нужно нажать "генерировать файл", когда появится сообщение, что файл сгенерирован, то нажать "тест". За сколько пройден тест, не считается, но разница очень сильно заметна.

[alibek]

Пробелы можно перебирать по InStr, это раза в два-три ускорит.

[Konst_One]

Код: Выделить всё

Dim arr() as String
Dim ProbelCount as Long

arr=split(LongString," ")
ProbelCount=iif(Ubound(arr)>0,Ubound(arr),0)

[Andrey Fedorov]

Я. конечно не пробовал, но:

Код: Выделить всё

s = Replace(MyString," ","")

Debug.Print "Пробелов: " & Len(MyString)-Len(s)
Debug.Print "Других символов: " & Len(s)


Ась?

[Nicky]

Я. конечно не пробовал, но:

Код: Выделить всё

s = Replace(MyString," ","")

Debug.Print "Пробелов: " & Len(MyString)-Len(s)
Debug.Print "Других символов: " & Len(s)


Ась?

По плавному кругу вернулись ко второму посту

[Andrey Fedorov]

По плавному кругу вернулись ко второму посту

И начинаем следующий круг - по спирали...

[x-rex]

В начале нужно нажать "генерировать файл", когда появится сообщение, что файл сгенерирован, то нажать "тест".

а теперь просто запустить

За сколько пройден тест, не считается, но разница очень сильно заметна.

А если время замерять, то твой вариант в ~20 быстрее

[Роман-вб]

Как видно, здесь собрались "строколюбы"
Ну помогите решить такую задачу:
В RichtextBox'e имеется текст. Необходимо найти все подстроки в данной сторке, которые начинаются с символа "Ш" и перекрасить их. Например:


Шнпрвлалмьирпалплатвлбвдптрьвлпрлдватплдва
оаоаолдаопладопоподШвадлвоадов
волоалвоалвоал
воапдлвыопдлывопдлоШвпаьвлдыоп
выпловаыдлпоавлдгполдоав

[BV]

InStr(Rev) или .Find

Получив позицию входа "Ш" закрашивай всё до vbCr.

[Роман-вб]

BV
Да, да, а поподробней. Здесь просто любителям сторк раз плюнуть.

[BV]

А подумать?

InStr возвращает позицию входа строки или символа в основной строке. В начале вызови InStr для поиска "Ш", после - для поиска vbCr. Теперь у тебя две позиции - место начала строки с "Ш" и конец основной строки. Выделяй и делай rtbMain.SelColor = vbBlue.

[Роман-вб]

Вот кое-что. Окончательно сделать не получилось . В данном случае процедура выполняется 1 раз, но это исправимо.

Код: Выделить всё

Private Sub Remark(ByVal rtb As RichTextBox, ByVal simvol As String)
        Dim text1 As String = rtb.Text, s$
        Static i As Integer, flg As Boolean
        If flg = False Then i = rtb.Find(simvol)
        s$ = Mid$(text1, i + 1, 1)
        If s$ = simvol Then
            rtb.SelectionStart = i
            Do
                i += 1
                Application.DoEvents()
            Loop Until (Mid$(text1, i + 1, 1) = vbCr)
            Application.DoEvents()
            rtb.SelectionLength = i
            rtb.SelectionColor = Color.Green
            If i <> text1.Length Then Call Remark(rtb, simvol)
            flg = True
        End If
    End Sub

Может ещё кто-нибудь что-нибудь предложит?

[BV]

Код: Выделить всё

Option Explicit
'Option Base 0
'Option Compare Binary

Private Sub Form_Activate()
    Dim intPos(0 To 1) As Integer
    intPos(0) = 1: intPos(1) = 1
    Do
        intPos(0) = InStr(intPos(1), rtbMain.Text, "Ш")
        If intPos(0) = 0 Then Exit Do
        intPos(1) = InStr(intPos(0), rtbMain.Text, vbCr)
        If intPos(1) = 0 Then Exit Do
        With rtbMain
            .SelStart = intPos(0) - 1
            .SelLength = intPos(1) - intPos(0)
            .SelColor = vbBlue
        End With
    Loop
End Sub

Private Sub Form_Load()
    rtbMain.Text = "Шнпрвлалмьирпалплатвлбвдптрьвлпрлдватплдва" & vbCrLf & _
                   "оаоаолдаопладопоподШвадлвоадов" & vbCrLf & _
                   "волоалвоалвоал" & vbCrLf & _
                   "воапдлвыопдлывопдлоШвпаьвлдыоп" & vbCrLf & _
                   "выпловаыдлпоавлдгполдоав"
End Sub

[Роман-вб]

BV
Спасибо конечно. Но... Оформляю это в подпрограмму, вызываю, и... ничего.

Код: Выделить всё

Private Sub Remark(ByVal rtbMain As RichTextBox)         
Dim intPos(0 To 1) As Integer
        intPos(0) = 1 : intPos(1) = 1
        Do
            intPos(0) = InStr(intPos(1), rtbMain.Text, "'")
            If intPos(0) = 0 Then Exit Do
            intPos(1) = InStr(intPos(0), rtbMain.Text, vbCr)
            If intPos(1) = 0 Then Exit Do
            With rtbMain
                .SelectionStart = intPos(0) - 1
                .SelectionLength = intPos(1) - intPos(0)
                .SelectionColor = Color.Green
            End With
        Loop

    End Sub

[Amed]

Роман-вб, ключевое слово ByVal что у нас обозначает?

[Роман-вб]

Amed
Чё ты придираешься?
Передача параметра по значению

[Amed]

Зачем оно?
И почему SelectionStart, а не SelStart?

Я медленно подвожу к решению, а не придираюсь. И не надо панибратства.

[Роман-вб]

Amed
Если CSerg увидит -- "убъёт" .
Да это просто с VB8. Принципиальной разницы в данном случае нет, поэтому и код только тем и отличается, что вместо SelectionStart -- SelStart.
И всё же хотелось бы узнать, где именно я ошибался......

[BV]

Может передашь объект по ByRef?

[Роман-вб]

BV
Толку нуль.

[Oxygen]

Вот ещё вариация на тему.

Код: Выделить всё


Private Sub Command1_Click()
a$ = RTB1.Text + vbCr
b = 0
i1 = 0: i2 = 0: j1 = 1
Do
i1 = InStr(j1, a$, "Ш")
If i1 = 0 Then b = 1: GoTo 10
i2 = InStr(i1, a$, vbCr)
RTB1.SelStart = i1 - 1: RTB1.SelLength = i2 - i1: RTB1.SelColor = vbBlue j1 = i2
10:
Loop Until (b = 1)
End Sub


[Роман-вб]

Oxygen
Большое спасибо, обязательно попробую.