Выбор случайного значения из списка-массива (спинтакс) - excel vba

Узнай цену своей работы

Формулировка задачи:

Всем доброго вечера! Не смог кратко полностью описать в заголовке вопрос, но как бы основную проблему написал. Теперь подробнее. На днях столкнулся с новой задачей и никак не могу ее до конца решить. Суть: Найти в файле "html" все конструкции типа спинтакс, например, "{Доброго дня|Здравствуйте|Привет}, {уважаемый|дорогой} Петр!", случайным образом выбрать один вариант и заменить им набор. Т.е., в результате должно получиться: - Доброго дня, уважаемыйПетр! - Здравствуйте, дорогой Петр! - Привет, уважаемый Петр! - и т.д. Возникшие вопросы: 1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM? Много всего перелопатил - получилось только импортом на лист (переделал из макрорекордера):
Листинг программы
  1. Sub loadhtml()
  2. Dim wb As Workbook
  3. Dim shM As Worksheet
  4. Set wb = ActiveWorkbook
  5. Set shM = wb.Sheets("Лист2")
  6. sFiles = "c:\test\1.html"
  7. With shM.QueryTables.Add(Connection:= _
  8. "TEXT;" & sFiles, Destination:= _
  9. Range("$A$1"))
  10. .AdjustColumnWidth = False
  11. .TextFilePlatform = 65001
  12. .Refresh BackgroundQuery:=False
  13. End With
  14. End Sub
Проблема этого решения, что я не знаю как искать конструкции "{||}" в случае, если начало конструкции в одной строке, а конец в другой. Плюс, мне кажется можно как-то обработать текст не записывая на лист, и соответственно будет работать быстрее. 2. Поиск конструкции "{||}" С учетом п.1, ищу построчно:
Листинг программы
  1. Sub spintaks()
  2. Dim wb As Workbook
  3. Dim shM As Worksheet
  4. Dim er& 'последняя строка
  5. Dim arrTemp 'массив синонимов
  6. Dim b& 'позиция искомого символа в строке, в нашем случае - "{"
  7. Dim s$ 'конструкция типа "{||||}"
  8. Dim a$ 'переменная для списка элементов массива
  9. Dim poz As Integer 'позиция случайно выбранного значения
  10. Dim wordi$ 'случайно выбранное значение (синоним) из массива
  11. Set wb = ActiveWorkbook
  12. Set shM = wb.Sheets("Лист3")
  13. er = shM.Cells(shM.Rows.Count, 1).End(xlUp).Row
  14. For i = 1 To er
  15. b = InStr(1, shM.Cells(i, 1).value, "{")
  16. Do While b <> 0
  17. stri = shM.Cells(i, 1).value
  18. s = Mid(stri, InStr(1, stri, "{"), Len(stri) - InStr(1, stri, "{") - (Len(stri) - InStr(1, stri, "}") - 1))
  19. a = Replace(Replace(s, "}", ""), "{", "")
  20. arrTemp = Split(a, "|")
  21. Randomize
  22. poz = Rnd * UBound(arrTemp)
  23. wordi = arrTemp(poz)
  24. shM.Cells(i, 1).value = Replace(shM.Cells(i, 1).value, s, wordi)
  25. b = InStr(1, shM.Cells(i, 1).value, "{")
  26. Loop
  27. Next i
  28. End Sub
Вопросы: -Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)? -Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}." 3. Сохранение полученного текста в формате "html" в кодировке UTF-8 без BOM. Решил таким образом:
Листинг программы
  1. Sub savehtm()
  2. Dim wb As Workbook
  3. Dim shM As Worksheet
  4. Dim er& 'последняя строка
  5. Dim mypath$ 'путь сохранения файла
  6. Set wb = ActiveWorkbook
  7. Set shM = wb.Sheets("Лист3")
  8. mypath = "c:\test\1.html"
  9. Set FSO = CreateObject("Scripting.FileSystemObject")
  10. Set outFile = FSO.CreateTextFile(mypath)
  11. er = shM.Cells(shM.Rows.Count, 1).End(xlUp).Row
  12. For i = 1 To er
  13. outFile.WriteLine shM.Cells(i, 1).value
  14. Next i
  15. outFile.Close
  16. ss = LoadTextFromTextFile(mypath)
  17. sss = SaveTextToFile(ss, mypath, "utf-8noBOM")
  18. End Sub
Функции "LoadTextFromTextFile" и "SaveTextToFile" нашел где-то на просторах интернета пару лет назад - спасибо автору - часто выручают:
Листинг программы
  1. Function SaveTextToFile(ByVal txt$, ByVal Filename$, Optional ByVal encoding$ = "windows-1251") As Boolean
  2. ' функция сохраняет текст txt в кодировке Charset$ в файл filename$
  3. On Error Resume Next: Err.Clear
  4. Select Case encoding$
  5. Case "windows-1251", "", "ansi"
  6. Set FSO = CreateObject("scripting.filesystemobject")
  7. Set ts = FSO.CreateTextFile(Filename, True)
  8. ts.Write txt: ts.Close
  9. Set ts = Nothing: Set FSO = Nothing
  10. Case "utf-16", "utf-16LE"
  11. Set FSO = CreateObject("scripting.filesystemobject")
  12. Set ts = FSO.CreateTextFile(Filename, True, True)
  13. ts.Write txt: ts.Close
  14. Set ts = Nothing: Set FSO = Nothing
  15. Case "utf-8noBOM"
  16. With CreateObject("ADODB.Stream")
  17. .Type = 2: .Charset = "utf-8": .Open
  18. .WriteText txt$
  19. Set binaryStream = CreateObject("ADODB.Stream")
  20. binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open
  21. .Position = 3: .CopyTo binaryStream 'Skip BOM bytes
  22. .flush: .Close
  23. binaryStream.SaveToFile Filename$, 2
  24. binaryStream.Close
  25. End With
  26. Case Else
  27. With CreateObject("ADODB.Stream")
  28. .Type = 2: .Charset = encoding$: .Open
  29. .WriteText txt$
  30. .SaveToFile Filename$, 2 ' сохраняем файл в заданной кодировке
  31. .Close
  32. End With
  33. End Select
  34. SaveTextToFile = Err = 0: DoEvents
  35. End Function
  36. Function LoadTextFromTextFile(ByVal Filename$, Optional ByVal encoding$) As String
  37. ' функция загружает текст в кодировке Charset$ из файла filename$
  38. On Error Resume Next: Dim txt$
  39. If Trim(encoding$) = "" Then encoding$ = "windows-1251"
  40. With CreateObject("ADODB.Stream")
  41. .Type = 2:
  42. If Len(encoding$) Then .Charset = encoding$
  43. .Open
  44. .LoadFromFile Filename$ ' загружаем данные из файла
  45. LoadTextFromTextFile = .ReadText ' считываем текст файла
  46. .Close
  47. End With
  48. End Function
Т.о., повторю вопросы: 1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM? 2. Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)? 3. Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}." Помогите пож-та. Вродь пока все, извините за большое количество текста..

Решение задачи: «Выбор случайного значения из списка-массива (спинтакс) - excel vba»

textual
Листинг программы
  1. ВсеСкобки = "\{(.*?)\}"
  2. СкобкиБезВложенных = "(\{([^\{\}]*)\})+"
  3. Выражение = Replace(ВсеСкобки, "(.*?)", СкобкиБезВложенных) + "|" + ВсеСкобки

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

11   голосов , оценка 3.818 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут