Выбрать дату в календареВыбрать дату в календаре

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

Возникшие вопросы:
1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM?
Много всего перелопатил - получилось только импортом на лист (переделал из макрорекордера):
Код
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

Проблема этого решения, что я не знаю как искать конструкции "{||}" в случае, если начало конструкции в одной строке, а конец в другой. Плюс, мне кажеться можно как-то обработать текст не записывая на лист, и соответственно будет работать быстрее.

2. Поиск конструкции "{||}"
С учетом п.1, ищу построчно:
Код
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

Вопросы:
-Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)?
-Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."

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("Лист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

Функции "LoadTextFromTextFile" и "SaveTextToFile" нашел где-то на просторах интернета пару лет назад - спасибо автору - часто выручают:
Скрытый текст

Т.о., повторю вопросы:
1. Как лучше считывать данные из файла "html" в кодировке UTF-8 без BOM?
2. Как обрабатывать если начало конструкции в одной строке, а конец в другой (вполне может быть что даже не в следующей, а через одну или две)?
3. Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."
Помогите пож-та.
Вродь пока все, извините за большое количество текста..
Отправка web-запроса и получение ответа XML (Макрос) Excel, Не получается получить ответ от веб-сервиса
 
Здравствуйте, уважаемые форумчане.
Я в VBA не очень (учусь) и с такими задачами еще не сталкивался (в основном работаю с таблицами/листами/ячейками), - руководство поставило
задачу сделать макрос проверки параметров сайта в Excel на основании API c сервиса recipdonor.com (пытаюсь сделать такой запрос: Проверка тИЦ).
4-й день уже гуглю и читаю форумы, вроде все более-менее понятно, но у меня никак не получается получить ответ на запрос.. Подскажите пож-та, что я делаю не так. Я думал, логически, ничего сложного не должно быть - интернет есть - разберусь, а ничего не получается..((
Код
Sub Zapros()
Set HTTP = CreateObject("MSXML2.XMLHTTP")
apiBase64 = "Basic RjkxNjhDNUUtQ0VCMi00ZmFhLUI2QkYtMzI5QkYzOUZBMUU0Ong="
sURL1 = "http://recipdonor.com/api/session/new HTTP/1.1"
sql1 = "<InitSession><Parameters><TaskVariant>Cy</TaskVariant></Parameters><DomainNames><string>mozilla.com</string></DomainNames><Refresh>true</Refresh></InitSession>"
HTTP.Open "PUT", sURL1, True
HTTP.SetRequestHeader "Host", "recipdonor.com:977"
HTTP.SetRequestHeader "Content-type", "text/xml; charset=utf-8"
HTTP.SetRequestHeader "Authorization", apiBase64
HTTP.SetRequestHeader "Content-Length", Len(sql1)
HTTP.send sql1
Do While HTTP.readyState <> 4
    DoEvents
Loop
otvet = HTTP.responseText
[A1].Value = otvet
End Sub
Сам макрос выполняется - но результат "0", точнее - нет ответа..((
Буду премного благодарен за помощь.
Спасибо.

Положу еще здесь описание API для даного запроса с сайта recipdonor.com:
Проверка тИЦ, Я.Каталог и Зеркало
Для осуществления проверки тИЦ используются два API метода /session/new и /session/get.
В примере мы проверим на тИЦ сразу несколько сайтов mozilla.com, mozilla.ru, google.com, msdn.microsoft.com. Инициализация проверки осуществляется методом /session/new.
Создадим проверку послав в API запрос вида:
Скрытый текст
После выполнения запроса мы получим ответ,
Скрытый текст
что говорит об успешном создании сессии проверки, где
Id - уникальный идентификатор сессии
ExpireAt - сессия будет уничтожена в указанное время
SessionStatus - Статус ToCheck говорит нам о том, что сессия поставлена на проверку

Системе на проверку параметра тИЦ может уйти некоторое время, ответ вы можете получить не сразу.
Для получения результатов проверки необходимо использовать метод /session/get

Формируем запрос:
Скрытый текст
Получаем ответ вида:
Скрытый текст
Страницы: 1
Наверх