Подсчёт фамилий в списке

@Spread · Регистрация: 07.01.2012

Студворк — интернет-сервис помощи студентам

В ТекстБокс1 есть список ФИО в котором их 9500:

Абакаров Азамат Салимович
Абакарова Заира Арсеновна
Абакумов Артем Александрович
Абасов Шамиль Муслимович
Аббазов Исмаил Умарович
Аббакумова Жанна Сергеевна
Абдиба Нино Важаевна
Абдулагатова Хадижат Бадрутдиновна
Абдулаев Магомед Абасович
Абдулаев Хусейн Новрузович
...

Задача такова: когда я нажимаю на Баттон1 в ТекстБокс2 выводится все ФИО которые больше всего встречаются в списке + рядом сколько они встречаются и так по убыванию.

Выводится в ТекстБоксе2 должно примерно так:

Абакарова Заира Арсеновна, 6
Абакумов Артем Александрович, 6
Абасов Шамиль Муслимович, 5
Аббазов Исмаил Умарович, 4
...

@Valery__ · 23.07.2012, 09:56

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Imports System.IO
Imports System.Text
 
Public Class Form1
    'путь к файлу с именами пользователей
    Dim UserName As String = Directory.GetCurrentDirectory & "\Список.txt"
    Dim ArryUserName() As String 'массив пользователей
    '
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'если файл существует то выражение true - читаем данные из файла
        If File.Exists(UserName) = True Then
            ArryUserName = IO.File.ReadAllLines(UserName, Encoding.Default) 'читаем данные в массив
        End If
        TextBox1.Clear() 'очищаем перед заполнением
        'заполняем TextBox1
        For Each d As String In ArryUserName
            TextBox1.AppendText(d & vbCrLf)
        Next
    End Sub
    'начинаем считать
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim arryDist As IEnumerable(Of String) = ArryUserName.Distinct 'массив без повторяющихся фамилий
        For i As Integer = 0 To arryDist.Count - 1
            Dim n As Integer = 0
            For j As Integer = 0 To ArryUserName.Count - 1
                If arryDist(i) = ArryUserName(j) Then n += 1
            Next
            TextBox2.Text = TextBox2.Text & arryDist(i) & " - " & n & vbCrLf 'заполняем TextBox2
        Next
    End Sub
End Class

@Spread · 23.07.2012, 18:59 **[ТС]**

Ссылка на объект не указывает на экземпляр объекта.
На next ругает вот тут:

VB.NET
1
2
3
For Each d As String In ArryUserName
            TextBox1.AppendText(d & vbCrLf)
        Next

Такая ошибка

@Valery__ · 23.07.2012, 20:40

VB.NET
1
2
3
4
'заполняем TextBox1
        For Each d As String In ArryUserName
            TextBox1.AppendText(d & vbCrLf)
        Next

Это обычный цикл по переборке элементов массива ArryUserName и через переменную d передаём в TextBox1. Можно заменить на равноценный код

VB.NET
1
2
3
For i As Integer = 0 To ArryUserName.Count-1
     TextBox1.Text = TextBox1.Text & ArryUserName(i) & vbCrLf
Next

@Spread · 23.07.2012, 22:48 **[ТС]**

Вот так получается

@ZuMiks · 23.07.2012, 23:27

Сообщение от Spread

Вот так получается

А ты файлик "Список.txt" в папке с программой создал?

@Spread · 24.07.2012, 00:05 **[ТС]**

я к нему и полный путь указывал, или в папке нужно?

Добавлено через 32 минуты
это моя ошибка!
извиняюсь!
всё работает, спасибо

@Alex77755 · 24.07.2012, 01:25

Если список большой, то имеет смысл воспользоваться словарём что бы не гонять цикл в цикле для подсчёта, а считать сразу. Код не проверял в данном случае - лениво создавать файл, но метод проверен неоднократно:

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Imports System.IO
Imports System.Text
 
Public Class Form1
    'путь к файлу с именами пользователей
    Dim UserName As String = Directory.GetCurrentDirectory & "\Список.txt"
    Dim ArryUserName() As String 'массив пользователей
    '
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
 
        'если файл существует то выражение true - читаем данные из файла
        If File.Exists(UserName) = True Then
            ArryUserName = IO.File.ReadAllLines(UserName, Encoding.Default) 'читаем данные в массив
        End If
        TextBox1.Clear() 'очищаем перед заполнением
        'заполняем TextBox1
        Dim oDict : oDict = CreateObject("Scripting.Dictionary")  ' Создаем словарь
        For Each d As String In ArryUserName
            TextBox1.AppendText(d & vbCrLf)
 
            If oDict.exists(d) Then 'если есть в словаре - считаем
                oDict.item(d) = oDict.item(d) + 1
            Else
                oDict.add(d, 1) ' иначе добавляем в словарь
            End If
        Next
        Dim M()
 
        M = oDict.keys
        TextBox2.Clear() 'очищаем перед заполнением
 
        For i As Integer = 0 To UBound(M) - 1
            TextBox1.AppendText(M(i) & " - " & oDict.item(M(i)) & vbCrLf)
        Next
 
    End Sub
 
 
End Class

@Spread · 24.07.2012, 18:01 **[ТС]**

в списке 9500 ФИО и программа не справляется с этим!
включил её и ждал два часа, результата нет!

@Alex77755 · 24.07.2012, 22:09

Что бы не быть голословным создал файл 40000 записей (40 ФИО рандомно перемешаны имена и отчества)
Вместо текстбоксов лучше использовать списки - быстрей заполнение.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Imports System.IO
Imports System.Text
 
Public Class Form1
 
    'путь к файлу с именами пользователей
    Dim UserName As String = "C:\Список.txt"
    Dim ArryUserName() As String 'массив пользователей
 
    Private Sub Form1_Load1(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Dim M()
        Dim T As Date
        T = Now
        'если файл существует то выражение true - читаем данные из файла
        If File.Exists(UserName) = True Then
            ArryUserName = IO.File.ReadAllLines(UserName, Encoding.Default) 'читаем данные в массив
        End If
        
        ListBox1.DataSource = ArryUserName
 
        Dim oDict : oDict = CreateObject("Scripting.Dictionary")  ' Создаем словарь
 
        For Each d As String In ArryUserName
            If oDict.exists(d) Then 'если есть в словаре - считаем
                oDict.item(d) = oDict.item(d) + 1
            Else
                oDict.add(d, 1) ' иначе добавляем в словарь
            End If
        Next
 
        M = oDict.keys
 
        For i As Integer = 0 To UBound(M) - 1
            M(i) = M(i) & " - " & oDict.item(M(i))
        Next
 
        ListBox2.DataSource = M
 
        Debug.Print(T)
        Debug.Print(Now)
 
    End Sub
End Class

в окне интерпритации:

24.07.2012 20:57:07
24.07.2012 20:57:10
Как видно всего 3 секунды

Добавлено через 4 минуты
Если уж подробно:

VB.NET
1
2
3
4
5
6
7
8
9
        Debug.Print(UBound(ArryUserName))
        Debug.Print(UBound(M))
        Debug.Print(T)
        Debug.Print(Now)
 
40001
7512
24.07.2012 21:07:14
24.07.2012 21:07:17

@Spread · 24.07.2012, 23:24 **[ТС]**

всё получилось! и очень даже быстро! а как сделать что бы они выводились у кого больше заявлений и к меньшему) по убыванию короче)

@Alex77755 · 25.07.2012, 14:27

что бы они выводились у кого больше заявлений и к меньшему

Это называется сортировка.
Способов много. В том числе и сам контрол умеет это делать.
По идее поставить в начале количество, а потом фамилию и в свойствах списка разрешить сортировку. По крайней мере в VB6 я так делал.

Добавлено через 16 минут
Попробовал в списке поставить сортировку - не получается: сортирует в текстовом режиме, по фамилиям.
Значит надо добавить функцию сортировки

Добавлено через 3 часа 30 минут
От метода сортировки зависить очень много. В данном случае сортировка заняла 3 с половиной минуты. Файл всё тот же 40000 записей с 7512 уникальных:
25.07.2012 12:45:20
25.07.2012 12:48:53

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Imports System.IO
Imports System.Text
 
Public Class Form1
 
    'путь к файлу с именами пользователей
    Dim UserName As String = "C:\Список.txt"
    Dim ArryUserName() As String 'массив пользователей
 
    Private Sub Form1_Load1(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Dim M()
        Dim T As Date
        Me.Show()
        T = Now
        'если файл существует то выражение true - читаем данные из файла
        If File.Exists(UserName) = True Then
            ArryUserName = IO.File.ReadAllLines(UserName, Encoding.Default) 'читаем данные в массив
        End If
 
        ListBox1.DataSource = ArryUserName
        Me.Refresh()
        Dim oDict : oDict = CreateObject("Scripting.Dictionary")  ' Создаем словарь
 
        For Each d As String In ArryUserName
            If oDict.exists(d) Then 'если есть в словаре - считаем
                oDict.item(d) = oDict.item(d) + 1
            Else
                oDict.add(d, 1) ' иначе добавляем в словарь
            End If
        Next
 
        M = oDict.keys
 
        For i As Integer = 0 To UBound(M)
            M(i) = M(i) & " - " & oDict.item(M(i))
        Next
 
        ListBox2.DataSource = M
        Me.Refresh()
        M = SORTIR(M)
        ListBox3.DataSource = M
 
        Debug.Print(T)
        Debug.Print(Now)
 
    End Sub
 
    Function SORTIR(ByVal Q)
        Dim R, C
        Dim T
          For R = 0 To UBound(Q) - 1
            For C = UBound(Q) To R + 1 Step -1
                If CDbl(Split(Q(C), " - ")(1)) > CDbl(Split(Q(C - 1), " - ")(1)) Then
                    T = Q(C - 1) : Q(C - 1) = Q(C) : Q(C) = T
                End If
 
            Next C
            Me.Show()
            Me.Text = R
        Next R
 
        SORTIR = Q
 
    End Function
End Class

Добавлено через 32 минуты
функция сортировки на две минуты быстрей

25.07.2012 13:22:45
25.07.2012 13:24:18

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
    Function SORTIR1(ByVal Q)
        Dim R, C, K
        Dim MAX
        Dim F()
        Dim T
        F = Q
        For R = 0 To UBound(Q) - 1
            MAX = 0
            For C = R + 1 To UBound(Q)
                If MAX < CDbl(Split(Q(C), " - ")(1)) Then
                    MAX = CDbl(Split(Q(C), " - ")(1)) : K = C
                End If
            Next C
            T = Q(R) : Q(R) = Q(K) : Q(K) = T
        Next R
        SORTIR1 = Q
    End Function

Новые блоги и статьи Все статьи Все блоги /
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.
Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .

@Spread 77 / 38 / 2 Регистрация: 07.01.2012 Сообщений: 414
	23.07.2012, 22:48 [ТС]
	Вот так получается Миниатюры 0

@Spread 77 / 38 / 2 Регистрация: 07.01.2012 Сообщений: 414
	24.07.2012, 00:05 [ТС]
	я к нему и полный путь указывал, или в папке нужно? Добавлено через 32 минуты это моя ошибка! извиняюсь! всё работает, спасибо 0

@Spread 77 / 38 / 2 Регистрация: 07.01.2012 Сообщений: 414
	24.07.2012, 18:01 [ТС]
	в списке 9500 ФИО и программа не справляется с этим! включил её и ждал два часа, результата нет! 0

@Spread 77 / 38 / 2 Регистрация: 07.01.2012 Сообщений: 414
	24.07.2012, 23:24 [ТС]
	всё получилось! и очень даже быстро! а как сделать что бы они выводились у кого больше заявлений и к меньшему) по убыванию короче) 0