Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.83/6: Рейтинг темы: голосов - 6, средняя оценка - 4.83
NaMoRZA
126 / 2 / 1
Регистрация: 24.07.2015
Сообщений: 17
1

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

16.09.2016, 22:16. Просмотров 1106. Ответов 6

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

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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, ищу построчно:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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.
Решил таким образом:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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" нашел где-то на просторах интернета пару лет назад - спасибо автору - часто выручают:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
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. Никак не придумаю как обрабатывать случаи, когда есть вложенные конструкции, например, "{Сегодня {отличный|хороший|прекрасный} день!|Как {дела|поживаете}}."
Помогите пож-та.
Вродь пока все, извините за большое количество текста..
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
16.09.2016, 22:16
Ответы с готовыми решениями:

Выбор случайного элемента из выпадающего списка
Итак, на листе &quot;Тест&quot; в ячейке &quot;А1&quot; я создал выпадающий список. Значения для этого списка берутся...

Выбор случайного значения из списка
Здравствуйте. Помогите пожалуйста выбрать случайное значение из списка. Сам код создания списка и...

Выбор случайного слова из списка
Мне необходимо, чтобы при нажатии на кнопку программа выбирала случайное слово из списка в...

Выбор случайного пункта из списка
Есть список, кнопка и lable. В списке несколько пунктов с надписями. При нажатии кнопки должен...

Выбор случайного элемента из списка
Доброго времени суток, форумчане! Как из HashSet&lt;Ingredient&gt; достать случайный элемент? public...

6
renat_dmitriev
390 / 292 / 121
Регистрация: 26.08.2016
Сообщений: 901
16.09.2016, 23:33 2
1. html это обычный текстовый файл, читаем его

Visual Basic
1
2
3
4
5
6
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso.OpenTextFile("c:\test\1.html", 1, True)
FileContent = ts.ReadAll 
ts.Close
Set ts = Nothing
Set fso = Nothing
Мы считали весь файл целиком и соответственно построчно считывать нам ничего не надо

2. По поводу вложенных конструкций можно для простоты алгоритма сделать в два или более прохода, в каждый проход считывать только конструкции без вложенных скобок и сразу заменять их

алгоритм будет примерно такой

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
result = ""
 
do while instr(FileContent, "{") > 0 
 
    do while true
 
        posOpen = instr(FileContent, "{")
 
        if posOpen = 0 then 
        
            result = result + fileContent
            fileContent = result
            exit do
 
        end if
 
        nextPosOpen = instr(mid(FileContent, posOpen + 1), "{")
        nextPosClose = instr(mid(FileContent, posOpen + 1), "}")
 
        if nextPosOpen = 0 or nextPosClose < nextPosOpen then 'То есть закрывающую скобку нашли раньше, чем открывающую, значит конструкция не вложенная
 
            textInside = mid(FileContent, posOpen + 1, nextPosClose - posOpen - 1)
            choice = ... 'тут алгоритм выбора из внутреннего текста одного значения, который помещаете в choice
            result = result + left(FileContent, posOpen - 1) + choice
            FileContent = mid(fileContent, NextPosClose + 1)
 
        else 
            
            result = result + left(fileContent, posOpen)
            fileContent = mid(fileContent, posOpen + 1)
 
        end if
 
    loop
 
    fileContent = result
 
loop
Добавлено через 2 минуты
И упрощайте код по максимуму, чтобы было нагляднее и удобнее работать, все эти навороченные конструкции с многократными Instr и Mid вложенными друг в друга сильно затрудняют чтение.

Добавлено через 8 минут
Еще такой код нарыл в интернете для чтения файла

Visual Basic
1
2
3
4
5
6
Dim objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.CharSet = "utf-8"
objStream.Open
objStream.LoadFromFile("c:\test\1.html")
strData = objStream.ReadText()
0
Святой НякаЛайк
625 / 222 / 81
Регистрация: 28.10.2015
Сообщений: 473
16.09.2016, 23:40 3
Поищите в интернетах в таком направлении: "Регулярные выражения в VB"
Так вам откроется инструмент RegExp, который много сильнее, чем использование MID
0
renat_dmitriev
390 / 292 / 121
Регистрация: 26.08.2016
Сообщений: 901
16.09.2016, 23:47 4
Святой НякаЛайк, Напишите пожалуйста пример выражения, которое находит вхождения между скобками в том числе и когда они вложенные. Мне для некой своей задачи, над которой я работаю, нужно. У меня как ни пытался не получилось. Либо только внешние скобки, либо выдает конструкцию "{...{...}" то есть не добирается до последней закрывающий скобки. Ограничился получением внешних скобок через регулярные выражения, а внутри уже пришлось парсить инстрами и мидами.
0
Святой НякаЛайк
625 / 222 / 81
Регистрация: 28.10.2015
Сообщений: 473
17.09.2016, 01:12 5
renat_dmitriev, Попробуйте такое:
Создали форму "Form1", на ней разместили листбокс "list1". В коде формы пишем это
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub Form_Click()
    Dim myRegExp As New RegExp ' создаём экземпляр RegExp'a
    myRegExp.MultiLine = False ' текст однострочный
    myRegExp.Global = True ' будем проходить всю строку
    myRegExp.IgnoreCase = True ' игнорируем регистр символов
    myRegExp.Pattern = "\{(.*)\}"
    Dim aMatch As Match ' один из совпавших образцов
    Dim colMatches As MatchCollection ' коллекция этих образцов
    Dim testString As String ' тестируемая строка
    Dim rezstr As String
    testString = "{HTML>{BODY bgcolor=#FFAABB}" & _
    "<P>Это пример</P></BODY></HTML}" ' текст для теста
metka:
    Set colMatches = myRegExp.Execute(testString) ' запускаем!
 
    For Each aMatch In colMatches ' проходим по всей коллекции
        List1.AddItem aMatch.FirstIndex
        List1.AddItem aMatch.Length
        List1.AddItem aMatch.SubMatches(0)
        List1.AddItem aMatch.Value
        rezstr = aMatch.SubMatches(0)
    Next aMatch
    If testString = rezstr Then GoTo endgame
    testString = rezstr
    GoTo metka
endgame:
End Sub
То есть, смысл таков: если вам удается выловить регулярным выражением текст без внешних скобок, то результат этого вылавливания можно сохранить в переменную и по этой переменной снова пройтись тем же выражением.
Такой второй проход и вычленит содержание вложенных скоб.
Извините за топорность, я если честно вообще ни разу не использовал ни рег выражения, ни парсинг по сути дела. Но идея есть и в теории должна вродь сработать

Добавлено через 6 минут
По крайней мере у меня на практике вышло добавление таких строк на листбоксе:
  • 0
  • 59
  • HTML>{BODY bgcolor=#FFAABB}<P>Это пример</P></BODY></HTML
  • {HTML>{BODY bgcolor=#FFAABB}<P>Это пример</P></BODY></HTML}
  • 5
  • 22
  • BODY bgcolor=#FFAABB
  • {BODY bgcolor=#FFAABB}
0
NaMoRZA
126 / 2 / 1
Регистрация: 24.07.2015
Сообщений: 17
17.09.2016, 02:25  [ТС] 6
Святой НякаЛайк, спасибо за помощь!
я уже раз 5 пробовал разобраться с рег.выражениями все никак не получается..(( не догоняю я их.. вродь иногда какой-то момент понятен, а всеравно не получается.
Попробую с утра разобраться с Вашим кодом, а то что-то сейчас уже сходу не понятно..
0
renat_dmitriev
390 / 292 / 121
Регистрация: 26.08.2016
Сообщений: 901
17.09.2016, 09:27 7
Цитата Сообщение от Святой НякаЛайк Посмотреть сообщение
То есть, смысл таков: если вам удается выловить регулярным выражением текст без внешних скобок, то результат этого вылавливания можно сохранить в переменную и по этой переменной снова пройтись тем же выражением.
Да, так можно, но когда текст несколько тысяч строк - это мой недавний случай - и в половине из них есть скобки, то один поиск регулярными выражениями выполняется меньше секунды, в чем их и преимущество, а если потом надобно каждое вхождение еще дополнительно execut-ом проверять, то выигрыша во времени по сравнению с поиском инстрами никакого, в обоих случаях программа подвисает на несколько секунд.

Хотя как вариант можно и тут двумя поисками: первым проходом нашли скобки без вложенных шаблоном \{([^\{\}]*)\}, считали и заменили их и потом вторым(если вложенность тройная-четверная то третьим и четвертым) поиском добираем оставшееся. При большом количестве нахождений это будет быстрее, чем применять экзекьют к каждому вхождению.

Но хочется все же найти волшебное выражение чтобы искало сразу все. Что я пробовал?
Visual Basic
1
2
3
ВсеСкобки = "\{(.*?)\}"
СкобкиБезВложенных = "(\{([^\{\}]*)\})+"
Выражение = Replace(ВсеСкобки, "(.*?)", СкобкиБезВложенных) + "|" + ВсеСкобки
Но получившееся выражение корректно находит в submatches только последнюю вложенную конструкцию, а если внутри фигурных скобок два или более других вхождения, то первые будут игнорироваться, значит нужно чтобы вложенные скобки находились в Matches, Но если в Matches попадает строка внутри внешних скобок целиком, тогда то что внутри попадает только в Submatches и только последнее вхождение. То есть если это выражение применено к строке

{Общ{Вхожд1}некий текст{Вхожд2}}

то будет одно вхождение - строка целиком, а в субматчез мы обнаружим только {Вхожд2}

думаю должна быть фишка в регулярных выражениях, чтобы то что внутри уже найденного также продолжался поиск и выводился в следующих матчез

Вобщем задача найти выражение, которое будучи применено к

{Общ{Вхожд1}некий текст{Вхожд2}...{Вхожд№}}

найдет
1. {Общ{Вхожд1}некий текст{Вхожд2}}
2. {Вхожд1}
3. {Вхожд2}
...
№ {Вхожд №}

как оно найдет все эти вхожды в субматчез или в матчез - мне без разницы.
0
17.09.2016, 09:27
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
17.09.2016, 09:27

Выбор случайного массива из 2х
Мне нужно сделать, чтобы программа присвоила переменной случайное значение переменной одного из 2х...

Выбор случайного элемента из массива и умножить его на другой случайный элемент из массива?
Выбор случайного элемента из массива и умножить его на другой случайный элемента из массива ?

Выбор случайного элемента из массива
Допустим есть одномерный массив int a = { 1, 2, 3, 4, 5 }; Нужно выбрать случайный элемент из...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru