Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.09.2016, 13:42   #1
NaMoRZA
 
Регистрация: 30.07.2010
Сообщений: 3
По умолчанию Выбор случайного значения из списка-массива (спинтакс)

Всем доброго дня!
Не смог кратко полностью описать в заголовке вопрос, но как бы основную проблему написал. Теперь подробнее.
На днях столкнулся с новой задачей и никак не могу ее до конца решить.
Суть:
Найти в файле "html" все конструкции типа спинтакс, например, "{Доброго дня|Здравствуйте|Привет}, {уважаемый|дорогой} Петр!", случайным образом выбрать один вариант и заменить им набор. Т.е., в результате должно получиться:
- Доброго дня, уважаемыйПетр!
- Здравствуйте, дорогой Петр!
- Привет, уважаемый Петр!
- и т.д.
Возникшие вопросы:
1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM?
Много всего перелопатил - получилось только импортом на лист (переделал из макрорекордера):

Код:
Sub loadhtml()
Dim wb As Workbook
Dim shM As Worksheet

Set wb = ActiveWorkbook
Set shM = wb.Sheets("html")

sFiles = "c:\test\123.html"
With shM.QueryTables.Add(Connection:= _
    "TEXT;" & sFiles, Destination:= _
    Range("$A$1"))
    .AdjustColumnWidth = False
    .TextFilePlatform = 65001
    .Refresh BackgroundQuery:=False
End With
End Sub
Проблема этого решения, что я не знаю как искать конструкции "{||}" в случае, если начало конструкции в одной строке, а конец в другой.
Еще в таком варианте, если длинная строка или есть табуляция, то ее при вгрузке эксель разбивает по разным ячейкам одной строки и тогда я вообще не соображу как обрабатывать. А одно из условий обработки - полное сохранение всего файла в таком же виде со всеми пробелами, табуляциями и т.п.
Есть вариант считывания текста целиком, но я не могу понять как его обрабатывать:

Код:
Dim objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.LoadFromFile("c:\test\123.html")
strData = objStream.ReadText()
2. Поиск конструкции "{||}"
С учетом п.1, ищу построчно:
Код:
Sub spintax()
Dim wb As Workbook
Dim shM As Worksheet
Dim er&         'последняя строка
Dim arrTemp     'массив синонимов
Dim b&          'позиция искомого символа в строке, в нашем случае - "{"
Dim s$          'конструкция типа "{||||}"
Dim a$          'переменная для списка элементов массива
Dim poz As Integer  'позиция случайно выбранного значения
Dim wordi$          'случайно выбранное значение (синоним) из массива

Set wb = ActiveWorkbook
Set shM = wb.Sheets("html")

er = shM.Cells(shM.Rows.Count, 1).End(xlUp).Row

For i = 1 To er
    b = InStr(1, shM.Cells(i, 1).value, "{")
    Do While b <> 0
        stri = shM.Cells(i, 1).value
        s = Mid(stri, InStr(1, stri, "{"), Len(stri) - InStr(1, stri, "{") - (Len(stri) - InStr(1, stri, "}") - 1))
        a = Replace(Replace(s, "}", ""), "{", "")
        arrTemp = Split(a, "|")
        Randomize
        poz = Rnd * UBound(arrTemp)
        wordi = arrTemp(poz)
        shM.Cells(i, 1).value = Replace(shM.Cells(i, 1).value, s, wordi)
        b = InStr(1, shM.Cells(i, 1).value, "{")
    Loop
Next i
End Sub
Вопросы:
-Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)?
-Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."

3. Сохранение полученного текста в формате "html" в кодировке UTF-8 без BOM.
Решил таким образом:
Код:
Sub savehtm()
Dim wb As Workbook
Dim shM As Worksheet
Dim er&         'последняя строка
Dim mypath$     'путь сохранения файла

Set wb = ActiveWorkbook
Set shM = wb.Sheets("html")
mypath = "c:\test\123_end.html"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set outFile = FSO.CreateTextFile(mypath)
er = shM.Cells(shM.Rows.Count, 1).End(xlUp).Row

For i = 1 To er
    outFile.WriteLine shM.Cells(i, 1).value
Next i
outFile.Close

ss = LoadTextFromTextFile(mypath)
sss = SaveTextToFile(ss, mypath, "utf-8noBOM")
End Sub
Функции "LoadTextFromTextFile" и "SaveTextToFile" нашел где-то на просторах интернета пару лет назад - спасибо автору - часто выручают:
Код:
Function SaveTextToFile(ByVal txt$, ByVal Filename$, Optional ByVal encoding$ = "windows-1251") As Boolean
    ' функция сохраняет текст txt в кодировке Charset$ в файл filename$
    On Error Resume Next: Err.Clear
    Select Case encoding$
 
        Case "windows-1251", "", "ansi"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(Filename, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-16", "utf-16LE"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(Filename, True, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-8noBOM"
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = "utf-8": .Open
                .WriteText txt$
 
                Set binaryStream = CreateObject("ADODB.Stream")
                binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open
                .Position = 3: .CopyTo binaryStream        'Skip BOM bytes
                .flush: .Close
                binaryStream.SaveToFile Filename$, 2
                binaryStream.Close
            End With
 
        Case Else
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = encoding$: .Open
                .WriteText txt$
                .SaveToFile Filename$, 2        ' сохраняем файл в заданной кодировке
                .Close
            End With
    End Select
    SaveTextToFile = Err = 0: DoEvents
End Function
Function LoadTextFromTextFile(ByVal Filename$, Optional ByVal encoding$) As String
    ' функция загружает текст в кодировке Charset$ из файла filename$
    On Error Resume Next: Dim txt$
    If Trim(encoding$) = "" Then encoding$ = "windows-1251"
    With CreateObject("ADODB.Stream")
        .Type = 2:
        If Len(encoding$) Then .Charset = encoding$
        .Open
        .LoadFromFile Filename$        ' загружаем данные из файла
        LoadTextFromTextFile = .ReadText        ' считываем текст файла
        .Close
    End With
End Function
Т.о., повторю вопросы:
1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM чтобы можно было максимально удобно обрабатывать текс?
2. Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)?
3. Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."
4. Да, и еще, в итоге всех манипуляций должен получиться файл html точно такой же как и исходный только с выбранными значениями из всех вариантов.
Прикрепленные файлы: 123.html - шблон, 123_end.html - вариант результата, spintaks.xlsm - текущий вариант обработки.
Помогите пож-та.
Вродь пока все, извините за большое количество текста..
Вложения
Тип файла: rar spintax.rar (22.5 Кб, 8 просмотров)

Последний раз редактировалось NaMoRZA; 17.09.2016 в 13:53.
NaMoRZA вне форума Ответить с цитированием
Старый 17.09.2016, 13:46   #2
NaMoRZA
 
Регистрация: 30.07.2010
Сообщений: 3
По умолчанию

Может можно как-то реализовать выбор случайного синонима с помощью регулярных выражений, но я никак не могу понять как это сделать.
NaMoRZA вне форума Ответить с цитированием
Старый 17.09.2016, 15:41   #3
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Цитата:
1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM чтобы можно было максимально удобно обрабатывать текс?
в чём связь - каким макросом считали текст, и удобство обработки текста?

считывать UTF-8 без BOM - есть же функция LoadTextFromTextFile
вызывайте её с параметром "utf-8"

Цитата:
2. Как обрабатывать если начало конструкции в одной строке, а конец в другой
вы про то, что в HTML встречаются переводы строки где попало?
так удалите все переводы строки (они не влияют ни на что в HTML), удалите лишние пробелы (функция Application.trim) - и потом ищите что вам нужно

Цитата:
Никак не придумаю как обрабатывать случаи
регулярные выражения вам помогут
самый простой способ
EducatedFool вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Выбор значения из раскрывающегося списка grh БД в Delphi 2 01.10.2012 11:13
Выбор значения по признаку из массива vvasilisk Microsoft Office Excel 2 20.02.2012 12:59
Выбор значения из списка с автозаполнением остальных полей. NHVStudio Microsoft Office Access 4 13.02.2012 09:25
Выбор минимального и максимального значения из списка диапазона mrantonio Microsoft Office Excel 3 24.10.2011 15:45
Как задать выбор значения с помошью списка в VBA? k.soldatova Помощь студентам 4 20.07.2011 16:58