ReSQL.ru
     
powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Оставить в рандомном тексте только ФИО
8 сообщений из 8, страница 1 из 1
Оставить в рандомном тексте только ФИО
    #39550336
Justvictor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Justvictor
Гость
Добрый день, уважаемые форумчане.

Исходные данные передаются в виде таблицы в MS Word (в наличии объединённые ячейки, заполнение вручную, которое приводит к проблемам в виде забытых или лишних пробелов, и.т.д)
Одно из полей таблицы "Persons" содержит в каждой ячейке некий текст. (в тексте есть ФИО и может также попадать организация, должность, сроки, и.т.д., а может не попадать, в общем, полный хаос)

ФИО может Быть как в формате Иванов А.А., так и Иванов Алексей Анатольевич

Задача заключается в том, чтобы выделить из этого текста ФИО в отдельный столбец.

шаг 1 экспортировал в MS Access
шаг 2 выделил строки, имеющие ФИО в формате Иванов А.А.

Код: sql
1.
2.
3.
4.
5.
SELECT New_list.Persons
FROM New_list
where Persons like "*[а-я]" & " " & "[А-Я]." & " " & "[А-Я].*" or
Persons like "*[а-я]" & " " & "[А-Я]." &  "[А-Я].*" or
Persons like "*[А-Я]." & " " & "[А-Я]."  & " " & "[А-Я].*"



Шаг 3 Попытался выделить ФИО в формате Иванов Алексей Анатольевич

Код: sql
1.
2.
3.
SELECT New_list.Persons, Mid(Persons, 1, Instrrev(Persons, ".")) as Persons2, Mid(Persons2, 1, Instrrev(Persons2, ".")) as Persons3,  Mid(Persons3, 1, Instrrev(Persons3, ".")) as Persons4
FROM New_list
where Persons like "*[А-Я!]*" & " " & "*[А-Я!]*" & " " & "*[А-Я!]*"



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

Шаг 4 застрял


Подскажите, если несложно как можно решить эту задачу

P.S. (мне видится алгоритм: удалить все слова, начинающиеся со строчных букв, удалить цифры и знаки, сделать Trim, далее если видим 3 слова подряд с большой буквы - выводим его как ФИО)

Вопрос только в том, как это сделать


Заранее спасибо!
...
Рейтинг: 0 / 0
09.11.2017, 15:40
| Ответить | Цитировать | Написать  
Оставить в рандомном тексте только ФИО
    #39550360
Фотография Akina
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Akina
Участник
1. Дополнить знаки препинания пробелами. Т.е. например "," -> ", "
2. Разбить строку на токены по пробелу
3. Обработать в потоке массив на предмет трёх элементов подряд, начинающихся с большой буквы

Типа

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Const Punctuations As String = "`~!@#$%^&*()_-+=:;""'|\<,>.?/№"

Function FindFIO(phrase As String) As String
Dim words() As String
For i = 1 to Len(Punctuations)
    phrase = Replace(phrase, Mid(Punctuations,i,1), Mid(Punctuations,i,1) & " ")
Next i
words = Split(phrase)
counter = 0
For i = 1 to UBound(words)
    If words(i) Like "[А-Я]*" Then
        counter = counter + 1
    Else
        counter = 0
    End If
    If counter = 3 Then
        FindFIO = Trim(words(i-2)) & " " & Trim(words(i-1)) & " " & Trim(words(i))
        Exit Sub
    End If
Next
...
Рейтинг: 0 / 0
09.11.2017, 16:11
| Ответить | Цитировать | Написать  
Оставить в рандомном тексте только ФИО
    #39550379
Justvictor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Justvictor
Гость
чуть подправил:
Option Compare Database

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
Const Punctuations As String = "`~!@#$%^&*()_-+=:;""'|\<,>.?/&#185;"

Function FindFIO(phrase As String) As String
Dim words() As String
For i = 1 To Len(Punctuations)
    phrase = Replace(phrase, Mid(Punctuations, i, 1), Mid(Punctuations, i, 1) & " ")
Next i
words = Split(phrase)
counter = 0
For i = 1 To UBound(words)
    If words(i) Like "[А-Я]*" Then
        counter = counter + 1
    Else
        counter = 0
    End If
    If counter = 3 Then
        FindFIO = Trim(words(i - 2)) & " " & Trim(words(i - 1)) & " " & Trim(words(i))
        Else
    End If
Next
End Function



Вот часть полученных результатов:

Persons (оригинал) FindFIO (что получилось)Фёдоров Д.А. Устранено в ходе проверки в ходе проверкиЧерных Д.Д. Начальник отдела охраны труда и промышленной безопасности отдела охраны труда

такое ощущение, что access не хочет узнавать больше одного слова с прописной буквы
access версии 2013
...
Рейтинг: 0 / 0
09.11.2017, 16:43
| Ответить | Цитировать | Написать  
Оставить в рандомном тексте только ФИО
    #39550392
Фотография Akina
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Akina
Участник
И чё, трудно пройти пошагово и почистить блох?
1) Option Compare Binary
2) For i = 0 To UBound(words)
...
Рейтинг: 0 / 0
09.11.2017, 16:57
| Ответить | Цитировать | Написать  
Оставить в рандомном тексте только ФИО
    #39550450
Justvictor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Justvictor
Гость
Спасибо, не сообразил(

Откорректировал и добавил несколько условий:
Код: vbnet
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.
Option Compare Binary

Const Punctuations As String = "`~!@#$%^&*()_-+=:;""'|\<,>.?/№»"

Function FindFIO(phrase As String) As String
Dim words() As String
For i = 1 To Len(Punctuations)
    phrase = Replace(phrase, Mid(Punctuations, i, 1), Mid(Punctuations, i, 1) & " ")
Next i
words = Split(phrase)
counter = 0
For i = 0 To UBound(words)
    If words(i) Like "[А-Я]*" Then
        counter = counter + 1
    Else
        counter = 0
    End If
    
    If words(i) Like "[А-Я][А-Я]*" Then
        counter = 0
        Else
    End If
    
    
    If counter = 3 Then
        FindFIO = Trim(words(i - 2)) & " " & Trim(words(i - 1)) & " " & Trim(words(i))
        Else
    End If
Next
End Function


Public Function DeleteAllRet6(ForStr As String) As String

Dim i As Long

Dim j As Long

Dim S As String

j = 0

For i = 1 To Len(ForStr)

    If Asc(Mid(ForStr, i, 1)) < 31 Then

        If i > 1 And j + 1 <> i Then DeleteAllRet6 = DeleteAllRet6 & Mid(ForStr, j + 1, i - 1)

        j = i

    End If

Next

DeleteAllRet6 = DeleteAllRet6 & Mid(ForStr, j + 1, i - 1)


End Function


Заработало уже практически

Осталась только одна проблема:
Функция может отловить Иванов А.А.но не может отловить Иванов А. А.
т.е., когда пробел между ИО
...
Рейтинг: 0 / 0
09.11.2017, 18:01
| Ответить | Цитировать | Написать  
Оставить в рандомном тексте только ФИО
    #39550452
Justvictor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Justvictor
Гость
функцию DeleteAllRet6 добавил для того, чтобы удалить непечатные знаки в тексте
...
Рейтинг: 0 / 0
09.11.2017, 18:02
| Ответить | Цитировать | Написать  
Оставить в рандомном тексте только ФИО
    #39550453
Justvictor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Justvictor
Гость
В общем не очень красиво, но как-то так получилось

Код: vbnet
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.
Option Compare Binary

Const Punctuations As String = "`~!@#$%^&*()_-+=:;""'|\<,>.?/&#185;»"

Function FindFIO(phrase As String) As String
Dim words() As String
For i = 1 To Len(Punctuations)
    phrase = Replace(phrase, Mid(Punctuations, i, 1), Mid(Punctuations, i, 1) & " ")
    phrase = Replace(phrase, "  ", " ")
Next i
words = Split(phrase)
counter = 0
For i = 0 To UBound(words)
    If words(i) Like "[&#192;-&#223;]*" Then
        counter = counter + 1
    Else
        counter = 0
    End If
    
    If words(i) Like "[&#192;-&#223;][&#192;-&#223;]*" Then
        counter = 0
        Else
    End If
    
    
    If counter = 3 Then
        FindFIO = Trim(words(i - 2)) & " " & Trim(words(i - 1)) & " " & Trim(words(i))
        Else
    End If
Next
End Function


Public Function DeleteAllRet6(ForStr As String) As String

Dim i As Long

Dim j As Long

Dim S As String

j = 0

For i = 1 To Len(ForStr)

    If Asc(Mid(ForStr, i, 1)) < 31 Then

        If i > 1 And j + 1 <> i Then DeleteAllRet6 = DeleteAllRet6 & Mid(ForStr, j + 1, i - 1)

        j = i

    End If

Next

DeleteAllRet6 = DeleteAllRet6 & Mid(ForStr, j + 1, i - 1)


End Function



Большое спасибо Akina за Вашу помощь!!!
...
Рейтинг: 0 / 0
09.11.2017, 18:05
| Ответить | Цитировать | Написать  
Оставить в рандомном тексте только ФИО
    #39550515
Фотография Akina
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Akina
Участник
Justvictorно не может отловить, Иванов А. А.
т.е., когда пробел между ИО
Моему коду сиренево - работает в обоих случаях. Хреново доработал,видать...

PS. И когда используешь тегш кода, смотри, ё моё, какой тип кода ставишь! и предпросмотром не брезгуй.
...
Рейтинг: 0 / 0
09.11.2017, 19:19
| Ответить | Цитировать | Написать  
8 сообщений из 8, страница 1 из 1
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Оставить в рандомном тексте только ФИО
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=45&msg=39550392&tid=1611925]:
 0ms
get settings:
 9ms
get forum list:
 15ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 67ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 51ms
get tp. blocked users:
 2ms
others: 257ms
total:  424ms
созд. / загр.: 424ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]