Выбор случайного значения из списка-массива (спинтакс) - excel vba
Формулировка задачи:
Всем доброго вечера!
Не смог кратко полностью описать в заголовке вопрос, но как бы основную проблему написал. Теперь подробнее.
На днях столкнулся с новой задачей и никак не могу ее до конца решить.
Суть:
Найти в файле "html" все конструкции типа спинтакс, например, "{Доброго дня|Здравствуйте|Привет}, {уважаемый|дорогой} Петр!", случайным образом выбрать один вариант и заменить им набор. Т.е., в результате должно получиться:
- Доброго дня, уважаемыйПетр!
- Здравствуйте, дорогой Петр!
- Привет, уважаемый Петр!
- и т.д.
Возникшие вопросы:
1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM?
Много всего перелопатил - получилось только импортом на лист (переделал из макрорекордера):
Проблема этого решения, что я не знаю как искать конструкции "{||}" в случае, если начало конструкции в одной строке, а конец в другой. Плюс, мне кажется можно как-то обработать текст не записывая на лист, и соответственно будет работать быстрее.
2. Поиск конструкции "{||}"
С учетом п.1, ищу построчно:
Вопросы:
-Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)?
-Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."
3. Сохранение полученного текста в формате "html" в кодировке UTF-8 без BOM.
Решил таким образом:
Функции "LoadTextFromTextFile" и "SaveTextToFile" нашел где-то на просторах интернета пару лет назад - спасибо автору - часто выручают:
Т.о., повторю вопросы:
1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM?
2. Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)?
3. Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."
Помогите пож-та.
Вродь пока все, извините за большое количество текста..
Листинг программы
- Sub loadhtml()
- Dim wb As Workbook
- Dim shM As Worksheet
- Set wb = ActiveWorkbook
- Set shM = wb.Sheets("Лист2")
- sFiles = "c:\test\1.html"
- With shM.QueryTables.Add(Connection:= _
- "TEXT;" & sFiles, Destination:= _
- Range("$A$1"))
- .AdjustColumnWidth = False
- .TextFilePlatform = 65001
- .Refresh BackgroundQuery:=False
- End With
- End Sub
Листинг программы
- Sub spintaks()
- 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("Лист3")
- 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
Листинг программы
- Sub savehtm()
- Dim wb As Workbook
- Dim shM As Worksheet
- Dim er& 'последняя строка
- Dim mypath$ 'путь сохранения файла
- Set wb = ActiveWorkbook
- Set shM = wb.Sheets("Лист3")
- mypath = "c:\test\1.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
Листинг программы
- 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
Решение задачи: «Выбор случайного значения из списка-массива (спинтакс) - excel vba»
textual
Листинг программы
- ВсеСкобки = "\{(.*?)\}"
- СкобкиБезВложенных = "(\{([^\{\}]*)\})+"
- Выражение = Replace(ВсеСкобки, "(.*?)", СкобкиБезВложенных) + "|" + ВсеСкобки
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д