Модераторы: mihanik
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Преобразование в транслит и запись в ячейку 
:(
    Опции темы
Mastodont
Дата 13.3.2011, 12:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 347
Регистрация: 18.3.2007

Репутация: нет
Всего: 1



У меня в Excel есть список вида

(см. вложение)

Я хочу написать скрипт на VBA, который будет:
  • читать данные из графы "ФИО"
  • делить их на фамилию, имя и отчество
  • фамилию переводить в транслит
  • имя и отчество обрезать до первых букв и тоже переводить в транслит. Затем склеивать фамилию и инициалы. К примеру, имеем "Иванов Виталий Алексеевич". Должны получить "IvanovVA".
  • записывать полученное в графу "Логин"
  • брать от логина только фамилию ("Ivanov"), преобразовывать первую прописную букву в строчную (что бы было "ivanov") и записывать в графу "Пароль"
Понимаю, что мне тут нужна будет таблица транслита и, по ходу, регулярные выражения.

Вопрос мой в другом: подскажите ссылки, по которым можно почитать информацию по моему вопросу. А то в гугле примеры не совсем для меня, немного сложные. А я VBA мало занимался (php в основном), долго в них разбирался. Вот на php знаю книжки, в которых конкретные мини-задачи разбираются (открытие файла, чтение из массива и тд.), кто подскажет на VBA похожие книжки?smile

Это сообщение отредактировал(а) Mastodont - 13.3.2011, 12:41

Присоединённый файл ( Кол-во скачиваний: 5 )
Присоединённый файл  delaem_vba_script_dlya_sozd_loginov_i_parolej_studentam_001.jpg 13,85 Kb
PM MAIL   Вверх
Akina
Дата 13.3.2011, 21:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454



Цитата(Mastodont @  13.3.2011,  13:41 Найти цитируемый пост)
подскажите ссылки, по которым можно почитать информацию по моему вопросу.

http://www.intuit.ru/department/se/vbamsoffice2007/

Цитата(Mastodont @  13.3.2011,  13:41 Найти цитируемый пост)
мне тут нужна будет таблица транслита 

Точнее, стандарт перевода.

Цитата(Mastodont @  13.3.2011,  13:41 Найти цитируемый пост)
регулярные выражения

Зачем?


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

PM MAIL WWW ICQ Jabber   Вверх
Дмит
Дата 15.3.2011, 09:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 21.4.2006
Где: г.Волгоград

Репутация: 8
Всего: 9



Когда-то писал пользовательскую функцию, может быть пригодится:
Код

Public Function ТРАНСЛИТ(Ячейки As Range, Optional RUEN As String) As Variant
Dim vX As Variant, strMass(1 To 1, 1 To 1) As String
Dim Ras As Boolean
Dim bkw As String, Prost As String, ProstA As String, str As String
Dim lNP As Long
Dim k As Long, j As Long, Max1 As Long, Max2 As Long
    If Ячейки.Cells.Count < 2 Then
        strMass(1, 1) = Ячейки.Value
        vX = strMass
    Else: vX = Ячейки
    End If
    Max1 = UBound(vX, 1)
    Max2 = UBound(vX, 2)
    If UCase(RUEN) = "EN" Then
        Prost = Liss2.Range("A32")
        ProstA = Liss2.Range("A31")
        For k = 1 To Max1
            For j = 1 To Max2
                strSumm = vbNullString
                str = vX(k, j)
                Max = Len(str)
                For i = 1 To Max
                    lNP = InStr(1, ProstA, Mid(str, i, 1), vbTextCompare)
                    Ras = (Asc(Mid(str, i, 1)) > 191 And Asc(Mid(str, i, 1)) < 224) Or Asc(Mid(str, i, 1)) = 168
                    If lNP > 0 Then
                        bkw = Mid(Prost, lNP, 1)
                    Else
                        Select Case LCase(Mid(str, i, 1))
                        Case "ё": bkw = "yo"
                        Case "ж": bkw = "zh"
                        Case "ч": bkw = "ch"
                        Case "ш": bkw = "sh"
                        Case "х"
                            bkw = "h"
                            If i > 1 Then
                                If LCase(Mid(str, i - 1, 1)) = "с" Then bkw = "x"
                            End If
                        Case "щ": bkw = "sh'"
                        Case "э": bkw = "e'"
                        Case "ю": bkw = "yu"
                        Case "я": bkw = "ya"
                        Case Else: bkw = Mid(str, i, 1)
                        End Select
                    End If
                    If Ras Then
                        strSumm = strSumm & UCase(bkw)
                    Else: strSumm = strSumm & bkw
                    End If
                Next
                vX(k, j) = strSumm
            Next
        Next
        ТРАНСЛИТ = vX
    Else:
        Prost = Liss2.Range("A34")
        ProstA = Liss2.Range("A33")
        For k = 1 To Max1
            For j = 1 To Max2
                strSumm = vbNullString
                str = vX(k, j)
                Max = Len(str)
                For i = 1 To Max
                    lNP = InStr(1, Prost, Mid(str, i, 1), vbTextCompare)
                    Ras = Asc(Mid(str, i, 1)) > 96 Or Mid(str, i, 1) = "'" Or Mid(str, i, 1) = "`"
                    If lNP > 0 Then
                        bkw = Mid(ProstA, lNP, 1)
                    Else
                        Select Case LCase(Mid(str, i, 1))
                        Case "c"
                            If LCase(Mid(str, i + 1, 1)) = "h" Then
                                bkw = "ч": i = i + 1
                            Else: bkw = "ц"
                            End If
                        Case "e"
                            If InStr(1, "`'", Mid(str, i + 1, 1), vbTextCompare) > 0 And i < Max Then
                                bkw = "э": i = i + 1
                            Else: bkw = "е"
                            End If
                        Case "j"
                            lNP = InStr(1, "joau", Mid(str, i + 1, 1), vbTextCompare)
                            If lNP > 0 And i < Max Then
                                bkw = Mid("йёяю", lNP, 1): i = i + 1
                            Else: bkw = "й"
                            End If
                        Case "s"
                            If LCase(Mid(str, i + 1, 1)) = "h" Then
                                If Mid(str, i + 2, 1) = "'" Or Mid(str, i + 2, 1) = "`" Then
                                    bkw = "щ": i = i + 2
                                Else: bkw = "ш": i = i + 1
                                End If
                            Else: bkw = "с"
                            End If
                        Case "y"
                            lNP = InStr(1, "oau", Mid(str, i + 1, 1), vbTextCompare)
                            If lNP > 0 And i < Max Then
                                bkw = Mid("ёяю", lNP, 1): i = i + 1
                            Else: bkw = "ы"
                            End If
                        Case "z"
                            If LCase(Mid(str, i + 1, 1)) = "h" Then
                                bkw = "ж": i = i + 1
                            Else: bkw = "з"
                            End If
                        Case "`"
                            If i > 1 Then
                                If Mid(str, i - 1, 1) = " " Then
                                    bkw = "`"
                                Else: bkw = "ъ"
                                End If
                            Else: bkw = "`"
                            End If
                        Case "'"
                            If i > 1 Then
                                If Mid(str, i - 1, 1) = " " Then
                                    bkw = "'"
                                Else: bkw = "ь"
                                End If
                            Else: bkw = "'"
                            End If
                        Case Else: bkw = Mid(str, i, 1)

                        End Select
                    End If
                    If Ras Then
                        strSumm = strSumm & bkw
                    Else: strSumm = strSumm & UCase(bkw)
                    End If
                Next
                vX(k, j) = strSumm
            Next
        Next
    End If
    ТРАНСЛИТ = vX
End Function

PM MAIL WWW   Вверх
Akina
Дата 15.3.2011, 09:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454



Эта функция не соответствует стандарту.
См. ГОСТ 7.79-2001 Правила транслитерации кирилловского письма латинским алфавитом.

Это сообщение отредактировал(а) Akina - 15.3.2011, 09:35

Присоединённый файл ( Кол-во скачиваний: 12 )
Присоединённый файл  7.79_2001.zip 19,11 Kb


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

PM MAIL WWW ICQ Jabber   Вверх
Дмит
Дата 15.3.2011, 11:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 21.4.2006
Где: г.Волгоград

Репутация: 8
Всего: 9



Да таблица не полностью соответствует ГОСТ 7.79-2001  smile 

Кстати, Вы знакомы с современным законодательством?
ГОСТы уже не есть последняя инстанция.
Впрочем это только удручает.

Думаю Mastodont сам доработает, тем более что задача у него шире
транслитерации.
PM MAIL WWW   Вверх
Akina
Дата 15.3.2011, 11:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454



Цитата(Дмит @  15.3.2011,  12:19 Найти цитируемый пост)
Вы знакомы с современным законодательством?
ГОСТы уже не есть последняя инстанция.
Впрочем это только удручает.

Если не существует документа, который явно изменяет установленные ГОСТом требования - то ГОСТ есть последняя инстанция. А если существует - то не факт, что он применим в каком-то конкретном случае... а порой - и что он вообще легитимен.


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

PM MAIL WWW ICQ Jabber   Вверх
Mastodont
Дата 18.6.2011, 00:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 347
Регистрация: 18.3.2007

Репутация: нет
Всего: 1



Спасибо за ответы. Если у кого-то еще будут мнения, пишите, с удовольствием почитаю.

Так как сам лучше всего знаю php, решение своего вопроса придумал именно на нем:

Написал три скрипта:

sozdaem_logini_i_paroli_studentov.php

Код

<?php
    
include("translit_fam.php");

include("translit_imya_otch.php");

function generateEmail($length = 6){
  $chars = 'abdefhiknrstyzABDEFGHKNQRSTYZ23456789';
  $numChars = strlen($chars);
  $string = '';
  for ($i = 0; $i < $length; $i++) {
    $string .= substr($chars, rand(1, $numChars) - 1, 1);
  }
  
  $string = strtolower($string);
  return $string;
}

$fio_studentov = file("fio_studentov.txt");

$kolvo_elem_massiva = count($fio_studentov);

//echo $kolvo_elem_massiva;

echo "<table border='1'>";
//<tr><td>ФИО студента</td><td>Логин</td><td>Пароль</td>";

for ($i = 0; $i < $kolvo_elem_massiva; $i++)
{
   $fio_studentov[$i] = split(" ", $fio_studentov[$i]);

/*   
   echo "Фамилия: ".$fio_studentov[$i]['0']."<br>";
   echo "Имя: ".$fio_studentov[$i]['1']."<br>";
   echo "Отчество: ".$fio_studentov[$i]['2']."<br><br>";
*/

   $pervaja_bukva_imeni = substr($fio_studentov[$i]['1'],0,1);
      
   //echo $fio_studentov[$i]['1']." - ".$pervaja_bukva_imeni."<br>";
   
   $pervaja_bukva_otch = substr($fio_studentov[$i]['2'],0,1);  
           
   $familija_v_translite = translit_fam($fio_studentov[$i]['0']);
   //echo $familija_v_translite;
   $imya_v_translite = translit_imya_otch($pervaja_bukva_imeni);
   
   $otchestvo_v_translite = translit_imya_otch($pervaja_bukva_otch); 

   $parol = strtolower($familija_v_translite);
   
   $dlina_parolya = strlen($parol);
   
   if ($dlina_parolya < 6)
   {
      $dobavit_kolvo_simvolov_v_parol = 6 - $dlina_parolya;
      
      for ($j = 0; $j < $dobavit_kolvo_simvolov_v_parol; $j++)
      {
         $parol = $parol."1";
      }
   }
   
   if ($dlina_parolya > 6)
   {
     $parol = substr($parol,0,6);  
   }
   
   echo "<tr>";
   
   //вывод просто фамилии
   //echo "<td>".$fio_studentov[$i]['0']."</td>";
   
   echo "<td>".$fio_studentov[$i]['0']." ".$fio_studentov[$i]['1']." ".$fio_studentov[$i]['2']."</td><td>Tamb_".$familija_v_translite.$imya_v_translite.$otchestvo_v_translite."</td>";
   
   //вывод случайного мыла
   //echo "<td>".generateEmail()."@inprofin.ru</td>";
   
   //вывод фамилии в качестве мыла
   echo "<td>".$parol."@inprofin.ru</td>";
   

   
   echo "</td><td>".$parol."</td></tr>";

}

echo "</table>";

?> 



translit_fam.php
Код

<?php

 function translit_fam($str) 
{
    $tr = array("а" => "a", "б" => "b", "в" => "v", "г" => "g", "д" => "d", "е" => "e", "ё" => "e", "ж" => "zh", "з" => "z", "и" => "i", "й" => "j", "к" => "k", "л" => "l", "м" => "m", "н" => "n", "о" => "o", "п" => "p", "р" => "r", "с" => "s", "т" => "t", "у" => "u", "ф" => "f", "х" => "h", "ц" => "c", "ч" => "ch", "ш" => "sh", "щ" => "sh", "ь" => "", "ы" => "i", "ъ" => "j", "э" => "e", "ю" => "ju", "я" => "ja", "А" => "A", "Б" => "B", "В" => "V", "Г" => "G", "Д" => "D", "Е" => "E", "Ё" => "E", "Ж" => "ZH", "З" => "Z", "И" => "I", "Й" => "J", "К" => "K", "Л" => "L", "М" => "M", "Н" => "N", "О" => "O", "П" => "P", "Р" => "R", "С" => "S", "Т" => "T", "У" => "U", "Ф" => "F", "Х" => "H", "Ц" => "C", "Ч" => "CH", "Ш" => "SH", "Щ" => "SH", "Ь" => "", "Ы" => "I", "Ъ" => "]", "Э" => "E", "Ю" => "JU", "Я" => "JA");
    $str = strtr($str,$tr);
    
    $str = strtolower($str);
    $str = ucfirst($str);
    
    return $str;
}

//echo translit_imya_otch("Юдина");
  ?>



Код

<?php

 function translit_imya_otch($str) 
{
    $tr = array("а" => "a", "б" => "b", "в" => "v", "г" => "g", "д" => "d", "е" => "e", "ё" => "e", "ж" => "z", "з" => "z", "и" => "i", "й" => "j", "к" => "k", "л" => "l", "м" => "m", "н" => "n", "о" => "o", "п" => "p", "р" => "r", "с" => "s", "т" => "t", "у" => "u", "ф" => "f", "х" => "h", "ц" => "c", "ч" => "c", "ш" => "s", "щ" => "s", "ь" => "", "ы" => "i", "ъ" => "j", "э" => "e", "ю" => "j", "я" => "j", "А" => "A", "Б" => "B", "В" => "V", "Г" => "G", "Д" => "D", "Е" => "E", "Ё" => "E", "Ж" => "Z", "З" => "Z", "И" => "I", "Й" => "J", "К" => "K", "Л" => "L", "М" => "M", "Н" => "N", "О" => "O", "П" => "P", "Р" => "R", "С" => "S", "Т" => "T", "У" => "U", "Ф" => "F", "Х" => "H", "Ц" => "C", "Ч" => "C", "Ш" => "S", "Щ" => "S", "Ь" => "", "Ы" => "I", "Ъ" => "]", "Э" => "E", "Ю" => "J", "Я" => "J");
    $str = strtr($str,$tr);
    
    $str = strtolower($str);
    $str = ucfirst($str);
    
    return $str;
}

//echo translit_imya_otch("Юдина");
  ?>



Еще есть файлик fio_studentov.txt, в котором в виде списка лежат ФИО всех студентов:
Цитата

Иванов Виктор Петрович
Козлов Николай Иванович


Все это складывается в одну папку и при открытии sozdaem_logini_i_paroli_studentov.php скрипт выводит в html таблицу с нужными мне данными. Ее выделяю, копирую и вставляю в Excel. Ну и подгоняю руками к нужному видуsmile

Что касается ГОСТов, то о чем вы, ребята?smile Мне это для внутреннего пользования, стандарты сам себе придумываю! Если они, конечно, начальством специально не оговорены.
PM MAIL   Вверх
Akina
Дата 18.6.2011, 11:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Советчик
****


Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 26
Всего: 454



Цитата(Mastodont @  18.6.2011,  01:09 Найти цитируемый пост)
Мне это для внутреннего пользования, стандарты сам себе придумываю!

Тогда зачем вообще спрашивать? делай как вздумается - и типа сойдёт...


--------------------
 О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

PM MAIL WWW ICQ Jabber   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Программирование, связанное с MS Office"
mihanik staruha

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами



  • Несанкционированная реклама на форуме запрещена
  • Пожалуйста, давайте своим темам осмысленный, информативный заголовок. Вопль "Помогите!" таковым не является.
  • Чем полнее и яснее Вы изложите проблему, тем быстрее мы её решим.
  • Оставляйте свои записи в "Книге отзывов о работе администрации"
  • А вот тут лежит FAQ нашего подраздела


Если Вам понравилась атмосфера форума, заходите к нам чаще!
С уважением mihanik и staruha.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Программирование, связанное с MS Office | Следующая тема »


 




[ Время генерации скрипта: 0.0838 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.