nilske, Или ссылки на платную надстройку, которая к тому же просит установить какой-то софт. Или робкие комментарии, что ничего не получится, раз IE не могет отработать скрипты страницы. Но во мне теплится надежда, что есть решение, может костыльное, но не сильно замороченное.
Я как то себе писал макрос, который запускал батник, который запускал прогу с параметром... Или например для пакетного word2pdf через файлик ява скрипт, который мог штатными средствами винды/офиса это делать, с отсылкой на него...
Возможно ли парсить сайты, если они не открываются в эксплоере? Сколько мониторил тему, так и не нашел решения. Если посылать страницу в любой другой браузер, то эксель не умеет работать с ними как .document . Но как то люди решают эти проблемы. Особо много сайтов не вспомню, но на вскидку пара есть, проверил на вин 10. Да, не открываются. https://dom.gosuslugi.ru/#!/houses
Добрый день. Сталкнулся с проблемой что бы не лазить на сайт, решил автоматизировать процесс. Но не пойму, то ли я не то делаю, то ли сайт не подходит под этот метод. Возмем несколько ИНН (3шт 2 МСП и одно нет)
6165061599- не МСП 6161085567- МСП 6165061599- не МСП 6161055347- МСП 6165061599- не МСП
При прогоне вместо необходимых МСП/Не МСП - выдает последнее удачно встреченное 6165061599- не МСП 6161085567- МСП от 67 6165061599- МСП от 67 6161055347- МСП от 47 6165061599- МСП от 47
Что я делаю не так?
Код
Private Sub inntoMSP() 'из а2 и ниже получить по ИНН данные
Dim IE As Object
Dim n As Integer
Dim sAnswer As String
On Error Resume Next ' пропуск ошибок
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.Navigate "https://ofd.nalog.ru/#"
While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend 'ожидание загрузки
With IE.Document
For n = 2 To Cells(Rows.count, 1).End(xlUp).Row ' берем по очереди ИНН
.GetElementsByName("query")(0).Value = Cells(n, 1).Value
.queryselector("#pnlSearch > div.quick-search-controls.form-layout-top-labels > div.form-field > div > div.field-value > button").Click ' нажать на найденый текст
Application.Wait Time:=Now + TimeValue("0:00:1")
Temp = IE.Document.queryselector("#tblResultData > tr > td:nth-child(2) > span").innertext
'Temp2 = IE.Document.queryselector("#tblResultData > tr > td:nth-child(1) > div.result-name > a > span").innertext
If Temp = 0 Then Sheets("ИНН").Cells(n, 2).Value = "не МСП" Else Sheets("ИНН").Cells(n, 2).Value = "МСП -" & Temp 'вставляем рядом найденное
Next n
End With
,Ігор Гончаренко, Спасибо, Вы волшебник))) 3 строчки вместо моих городуль.
А на листе 1 Вы макрос подправляли или у Вас якась автоматическая программа(встречал, но не юзал, например указываешь модуль, а она его чистит от пробелов и комментариев...), а то там кусочек удалили, так по 2му клику было если пусто ставим ок, если не пусто отчищаем..... но это так, я просто к слову...
А "Ямало-Ненецкий автономный округ, промзона панель "П" район 2-й котельной ГСК "Пилот" гараж № 488" - тут кроме округа ничего,
Т.е. как я понимаю столбцы C и Д это отдельно от столбца а, просто как таблица соответствий Иначе вторая строка и далее бред
105064, г. Москва, ул. Садовая-Черногрязская, д. 13/3, с.1, кв.87
Адыгейск
Адыгея
и в столбцах город встречаются не все города, т.е. г Ишма это какой субъект?
Я бы пошел таким пктем
Для начала на отдельный лист вынес C и Д , удали дубли а потом формулой со звездочкой посчитал, но тут тогда проблема двойных просчетов Архангельск посчитает и архангельскую область, тогда запятую меняем на пробел и добавляем к концу строки пробел, этим отсеим похожие срабатывания, но все равно что то нето, тогда далее приводить столбец А к общему виду. Если трогать столбец нельзя, то копируем его например в столбец Б и играемся там(формулу ссум правим). Ищем закономерности, если адрес ул и пер всегда в конце, то удаляем например через найти и заменить найти "пробел ул пробел *" пробелы, что бы не нароком не удалить лишнего, т. к. * удалит все после встретившегося. Потом " пер " "пр-кт " и т. д. так авось что и получится.
Ну или сразу найти заменить " москва пробел" на субъект москва, и так по всем субъектам, а что не нашло, то ручками. Скорее всего даже циклом можно, но тут для меня уже думать долго надо, я как кодер совсем не силен...
Ну и в обратном порядкуе надо что то придумать, т.к. в таблице сравнения не все субъекты, как отлавить не посчитанные.
Добрый день. Двойным кликом в столбце F активируктся форма с данными из массива, выбор вставляется в активную ячейку.
Не получается совместить подстановку остальных частей массива в другие столбики
Попытался через макрос который сверяет значение активной ячейки, если находит, то подставляет из массива, но в модуле userform отказывается работать как кусок кода, так и ссылка на макрос и даже функция макрос который вроде как работает в модуле 2 с названием СЦ1 встроить ума не хватило.
Вероятно соль в публичности массива и передаче его между модулями и userform , но это не точно. Чем больше читаю, тем больше начинаю путаться.
, Казанский,благодарю за "'$&") и ссылку на справку т.к. в статьях обычно пишут про сами выражение \s\d\w и т.д... а про это догнал только из коммента...
Msi2102 - , Очень большое спасибо, реально круто. Если обернут в отключение обновлений отрабатывает не зависимо от кол-ва RE.Pattern-ов, к слову я штук 5 добавил и не хочу на этом останавливаться) Если кому надо ищите RegEx в Excel: шпаргалка по синтаксису регулярных выражений и в RE.Pattern ставим нужное
Регулярные выражения не осилил, мозг закипел, в сообщении 7 работает, но хотел добавить еще критерий, что бы изменения происходили только после последней запятой. Вопрос еще открыт. Надеюсь по свободе разберусь.
Пока Родил монстра
Код
For Each element In Selection
sText = element.Value
n = InStrRev(sText, ",") ' ищем положение зпт с конца(номер символа в строке)
n = n + 1' зачем то добавляем 1 ))) без этого не работает
АБВ = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
For i = 0 To UBound(АБВ )
For x = 0 To 9
sTextREP = Replace(element.Value, x & " " & АБВ (i), x & АБВ (i), [n])'ищем\заменяем где n это начало откуда ищем
element.Value = Left$(sText, n - 1) & sTextREP'и каждый раз записываем изменения
Next x
Next i
Next 'и так по кругу
,нет предела совершенству, я вот впервые столкнулся с автоматизацией и мой корявый код отрабатывал 40 минут, сейчас уже 6-8, а завтра глядишь и на 3 выйду))) но это все равно лучше, чем верстать в ручную пол дня начальнику очередную бесполезную табличку, которую он толком и не посмотрит, но делать надо...
For Each element In Selection
sText = element.Value
n = InStrRev(sText, ",") ' ищем положение зпт с конца(номер символа в строке)
n = n + 1' зачем то добавляем 1 ))) без этого не работает
ÀÁÂ = Array("À", "Á", "Â")' добавляем всякие условия
For i = 0 To UBound(ÀÁÂ)
For x = 0 To 9
sTextREP = Replace(element.Value, x & " " & ÀÁÂ(i), x & ÀÁÂ(i), [n])'ищем\заменяем где n это начало откуда ищем
element.Value = Left$(sText, n - 1) & sTextREP'и каждый раз записываем изменения
Next x
Next i
' MsgBox element.Value
Next 'и так по кругу
но как то не айс, долгий, корявый, видимо нужен иной подход...
, я все таки отвечу тут, и далее по замене не жду пояснений в этой теме, да и другая тема увы не сегодня.
element.Value = переменная пробовал, впрочем смотрю через
Код
msgbox переменная
а что касается методов, то на выходе то получим одно и тоже т.к. накопление замен может встретиться может только единожды, по краййней мере в моем случае( он же ищет пробел между цифрой и буквой, и перебирает все варианты), хотя конечно может наверное и нет... уф.
P/S за опечатки ссори, т.к. через рдп, с плохим интернетом, и из-за лагов то 2 знака, то не тот и не увидел, то не тот порядок...
дай Бог Вам здоровья, в будущем постараюсь придумать имена переменным более разнообразные и креативные, сейчас менять не надо, а то совсем запутаюсь(возможно не только я) в принципе оно, но все равно не работает))) выдает как и было, начал разбираться не работает замена
метод Range.Replace работает, а метод Replace(где,что, на что) почему то нет, попробовал отдельно,
работает
Код
АБВ = Array("первое", "пятое", "десятое")
For i = 0 To UBound(АБВ)
For x = 0 To 9
Selection.Replace x & " " & АБВ(i), x & АБВ(i)
Next
Next
не работает
Код
переменная=element.Value
АБВ = Array("первое", "пятое", "десятое")
For i = 0 To UBound(АБВ)
For x = 0 To 9
sText = Replace(переменная, x & " " & АБВ(i), x & АБВ(i))
Next x
Next i
element.Value=sText
причем x & " " & АБВ(i), x & АБВ(i) заменить на пару статичных значений, да хоть на "1", "2", то работает
скорее бы выходные, может просто я разбираюсь без бутылки, по этому так сложно разобраться? )))
было уже обрадовался что увидел свет в конце тонеля, т.к. мелькнула мысль через InStrRev и mid определить положение и добавить параметр Start, но нет. (лирическое отступление, можно же пойти другим путем, определить последнюю запятую и все замены производить после нее, была мысль, но почемуто вспомнились формулы с поискпоз и меня проняла дрожь) метод Range.Replace не имеет такого параметра как start в отличии от метод Replace(где,что, на что)
насколько читал переменную можно объявлять сколь угодно раз, актуально последнее, по этому думал aSpl в 1й раз масив, что бы в нем вычленить хвостик, а второй раз как сам хвостик, ну ок, ввел\изменил на еще одну переменную aSplf(есть подозрение, что половину можно не объявлять, но для наглядности и пошаговости без этого пока не куда)
, че то не пойму, по коду он берет текст ячейки, разбивает по запятой с пробелом, в этих кусках ищет и меняет майку на фуфайку, если нашел меняет, если не нашел втавляет без изменений , я правильно его понял? с sText =Mid$(sText,3) не разобрался, в справке пока не прозрачно. почему 3
А я ворочу другое , он взял одну ячейку, взял последний "хвост после запятой" в нем произвел замену, и вернул все но с правками
Код
Sub test()
Dim aSpl As Variant
Dim АБВ, a, sText, aSplf, aSpln As String
Dim element As Range 'объявляем переменные
For Each element In Selection 'идем по ячейкам
a = element.Value 'берем ячейку
aSpl = Split(a, ", ") 'делаем из нее масив
aSpln = UBound(aSpl) 'определяем последнее после запятой
aSplf = aSpl(aSpln)'берем последнее после запятой
' в этом хвостике прогоняем по ряду правил
АБВ = Array("первое", "пятое", "десятое")
For i = 0 To UBound(АБВ)
For x = 0 To 9
sText = Replace(aSplf, x & " " & АБВ(i), x & АБВ(i)) ' по идее получаем исправленный хвостик в данном примере между цифрой и пятым\десятым удаляем пробел, отдельно такой макрос работает
Next x
Next i
' конец замены в этом хвостике
finish = a & sText
element.Value = finish ' записываем как было, только с исправленным хвостиком, вот тут и ошибка
Next' переходим к следующей ячеке
End Sub
явно финиш не верен, или не верно все? sText = Replace не отрабатывает надо из а вычленить aSplf , т.е математически finish = a -aSpl & sText
Sub test()
Dim element As Range, a As Variant 'цикл по ячейкам
For Each element In Selection
a = element.Value 'значение конкретной ячейки
a = VBA.Split(a, ", ") ' отделяем на части по критерию ", "
n = UBound(a) 'a(n) это последнее после запятой с пробелом , т.е. если у нас было "мама, папа, брат", то получим a(n)=Брат
msgBox a(n)
Next
End Sub
А как теперь к этому a(n) применить макрос и вернуть все в зад но с изменениями? Допустим если замена
Код
a(n) = Replace(a(n), одно, другое)
, то это же как то надо записать все назад ( причем у меня в замене еще пара циклов, по этому думал что проще сослаться на макрос)
Хотя бы верной ли логикой я иду? Как понимаю теперь нужно назад что-то типа сцепить LBound(a) to [UBound(a) - 1] + a(n)?
По Вашему коду до меня дошло, что Х = это переменная масива букв, т.е. можно обьявить еще оду переменную с цифрами и комбинировать их. А тот же массив может содержать не только "А", но и например выражение "АА", правильно? Спасибо, буду пробывать, извените за косноязычие , если что. Считайте, что я гуманитарий ))) А я то думал, что Х это цифры от 0 до 9... как было в моем первом макросе.
Эту задачу например можно было бы решить и через таблицу соответствий, создаешь табличку 1 а/1а 2 а/2а ... и т.д. табличку делать минуты 3 с учетом прогрессии и объеденения/сцепки, а далее макросом , это конечно элегантно, но с доп таблицей...
Код
Set x = Intersect(Sheets("лист откуда").[A2:A15], Sheets("лист откуда").UsedRange)
For i = 1 To x.Rows.Count
Intersect(Sheets("лист где меняем").[d2:d99999], Sheets("лист где меняем").UsedRange).Replace x(i, 1), x(i, 2)
Jack Famous написал: По коду №1: нужно ЗАМЕНИТЬ пробелы между числами на произвольный текст
В данном случае да, но вообще это может быть любой символ или их сочетание, например Х&" к "&У заменить на Х&" - "&У , где х и у любые указанные значения, цифры, или определенные символы, или даже знаки....
Цитата
написал: По коду №2: нужно УДАЛИТЬ пробелы, идущие после цифр и перед строчными буквами (не наоборот)Не учтён обратный порядок (после букв и перед цифрами) а также регистр букв. Надо или нет - ХЗ
Ну опять таки, в этом случае были пробелы, но хотелось инструмент, который нужное(знак, букву, пробел) поменяет на нужное(знак,букву, пробел), для того и 2 переменные, одна с цифрами, другая с буквами. Регистр и прочее я так понимаю решается в моем случае не обязательными параметрами MatchCase:=False
Эксэль ВЕЛИКАЯ вещь, ии способов решения не один и даже не 2. Про Регулярки слышал. Не люблю функции и доп столбцы, люблю кнопки)))
Ваш код увы отрабатывает не верно, убивает все пробелы, но оно и по коду мне не видно, Selection.Replace x & " ", x где указана АБВ, и как ее задействовать, на удивление код с i убивает только пробелы между цифрой и буквой, а между цифрой/цифрой или буквой/буквой не трогает...
Добрый, попалась гадкая таблица для анализа и сравнения, но проглядывалась некая система, между цифрами в конце пробел, а должен быть символ. Ну я как програмист мягко говоря не очень, но думаю по идее замены макрорекодер пишет, попробую. На удивление сработало. Х и У тут отдельно, т.к. мне кажется что только Х отработает 0&" "&0 ,1&" "&1, 2&" "&2 ,3&" "&3 ... 9&" "&9 или я ошибаюсь?[ т.е. было г. Азов Васильева 79 1 стало г. Азов Васильева 79что нибудь1 г. Азов, Васильева, д. 79 1 стало г. Азов, Васильева, д. 79что нибудь1
Код
Sub замена()
Dim x, y As Integer
For x = 0 To 9 '
For y = 0 To 9
Selection.Replace What:=x & " " & y, Replacement:=x &"что нибудь"& y, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
Next
End Sub
Но вопрос на самом деле не в этом(просто плодить темы на схожую тему не правильно) Вот с буквами сложнее, объявил массив и если пишу Selection.Replace x & "что нибудь" & АБВ, x & АБВ, где АБВ-имя переменной, то ошибка, попытался втулить for each, вообще закидало ошибками.
по запарке оставил i и вроде бы отрабатывает, но мне не ясно почему? Я ведь i не объявлял, что оно значит? или это нечто по умолчанию? т.е. было г. Азов Васильева 79 Б стало г. Азов Васильева 79Б г. Азов , Васильева,, 79 Б стало г. Азов ,Васильева,, 79Б
Код
Sub замена2()Dim x As VariantDim АБВ As Variant
АБВ = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
For x = 0 To 9 '
Selection.Replace x & " " & i, x & i
Next
End Sub
, с майнерами мне все равно не сравниться. так то агрегатор я ес-но поправлю с D:D на D2:D99999
А с впр "*, Ростов*" , этот момент я тоже осознаю, и учитываю при ручной проверке, просто на радостях не акцентировал внимание, все зависит от структуры таблитцы и ее логики, например осле Ростов может быть пробел или зпт, а так же он может быть Великим...