Гость
Войти | Профиль | Очистить
Действия ...
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Оставить в рандомном тексте только ФИО / 8 сообщений из 8, страница 1 из 1
09.11.2017, 15:40
    #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, 16:11
    #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:43
    #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:57
    #39550392
Akina
Akina
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Оставить в рандомном тексте только ФИО
И чё, трудно пройти пошагово и почистить блох?
1) Option Compare Binary
2) For i = 0 To UBound(words)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.11.2017, 18:01
    #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:02
    #39550452
Justvictor
Justvictor
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Оставить в рандомном тексте только ФИО
функцию DeleteAllRet6 добавил для того, чтобы удалить непечатные знаки в тексте
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
09.11.2017, 18:05
    #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, 19:19
    #39550515
Akina
Akina
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Оставить в рандомном тексте только ФИО
Justvictorно не может отловить, Иванов А. А.
т.е., когда пробел между ИО
Моему коду сиренево - работает в обоих случаях. Хреново доработал,видать...

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


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