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

Страницы: 1 2 3 4 5 6 След.
Парсер проверка по ИНН в реестре налоговой
 
решил через закрытие
ie.quit
Изменено: mihail_ms - 08.09.2022 18:32:20
Парсер проверка по ИНН в реестре налоговой
 
Добрый день. Сталкнулся с проблемой
что бы не лазить на сайт, решил автоматизировать процесс. Но не пойму, то ли я не то делаю, то ли сайт не подходит под этот метод. Возмем несколько ИНН (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
        
вставка из userform в требуемые ячейки согласно данных из многомерного масива
 
, согласен со всем кроме Else ActiveCell.Value = ""   по мне вполне логична)))

не суть.

И запуск макроса через апликашн ран заработало...

Пошел дальше пилить для себя кнопку "сделать волшебство"
Скрытый текст
вставка из userform в требуемые ячейки согласно данных из многомерного масива
 
,Ігор Гончаренко, Спасибо, Вы волшебник)))
3 строчки вместо моих городуль.

А на листе 1 Вы макрос подправляли или у Вас якась автоматическая программа(встречал, но не юзал, например указываешь модуль, а она его чистит от пробелов и комментариев...), а то там кусочек удалили, так по 2му клику было если пусто ставим ок, если не пусто отчищаем..... но это так,  я просто к слову...
Подсчет количества пользователей в каждом субъекте РФ по адресу
 
Таблица очень грязная,  

А "Ямало-Ненецкий автономный округ, промзона панель "П" район 2-й котельной ГСК "Пилот" гараж № 488" - тут кроме округа ничего,

Т.е. как я понимаю столбцы C и Д это отдельно от столбца а, просто как таблица соответствий
Иначе вторая строка и далее бред
105064, г. Москва, ул. Садовая-Черногрязская, д. 13/3, с.1,   кв.87АдыгейскАдыгея
и в столбцах город встречаются не все города, т.е. г Ишма это какой субъект?

Я бы пошел таким пктем

Для начала на отдельный лист вынес C и Д , удали дубли
а потом формулой со звездочкой посчитал, но тут тогда проблема двойных просчетов Архангельск посчитает и архангельскую область, тогда запятую меняем на пробел и добавляем к концу строки пробел, этим отсеим похожие срабатывания, но все равно что то нето, тогда далее приводить столбец А к общему виду. Если трогать столбец нельзя, то копируем его например в столбец Б и играемся там(формулу ссум правим). Ищем закономерности, если адрес ул и пер всегда в конце, то удаляем например через найти и заменить найти "пробел ул пробел *" пробелы, что бы не нароком не удалить лишнего, т. к. * удалит все после встретившегося. Потом  " пер " "пр-кт " и т. д.  так авось что и получится.

Ну или сразу найти заменить " москва пробел" на субъект москва, и так по всем субъектам, а что не нашло, то ручками.
Скорее всего даже циклом можно, но тут для меня уже думать долго надо, я как кодер совсем не силен...

Ну и в обратном порядкуе надо что то придумать, т.к. в таблице сравнения не все субъекты, как отлавить не посчитанные.


Пока мыслей больше нет
Изменено: mihail_ms - 18.03.2022 19:54:11
вставка из userform в требуемые ячейки согласно данных из многомерного масива
 
Добрый день.
Двойным кликом в столбце 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 'и так по кругу

Но он конечно тормоз еще тот.  
Изменено: mihail_ms - 18.02.2022 11:59:22
Изменить фрагменты текста и сцепить их обратно
 
,нет предела совершенству, я вот впервые столкнулся с автоматизацией и мой корявый код отрабатывал 40 минут, сейчас уже 6-8, а завтра глядишь и на 3 выйду))) но это все равно лучше, чем верстать в ручную пол дня начальнику очередную бесполезную табличку, которую он толком и не посмотрит, но делать надо...
Изменено: mihail_ms - 18.02.2022 02:12:08
Изменить фрагменты текста и сцепить их обратно
 
Кароч дожал, чуть не .... не будем об этом))


Код
 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 'и так по кругу

но как то не айс, долгий, корявый, видимо нужен иной подход...

Изменено: mihail_ms - 18.02.2022 01:43:31
Изменить фрагменты текста и сцепить их обратно
 
, я все таки отвечу тут, и далее по замене не жду пояснений в этой теме, да и другая тема увы не сегодня.

element.Value =  переменная пробовал, впрочем смотрю через
Код
msgbox переменная

а что касается методов, то на выходе то получим одно и тоже т.к. накопление замен может встретиться может только единожды, по краййней мере в моем случае( он же ищет пробел между цифрой и буквой, и перебирает все варианты), хотя конечно может наверное и нет... уф.

P/S за опечатки ссори, т.к. через рдп, с плохим интернетом, и из-за лагов то 2 знака, то не тот и не увидел, то не тот порядок...
Изменить фрагменты текста и сцепить их обратно
 
,в принципе да, но вообще изначально тема называлась чуть иначе,что то типа как применить макрос к переменной... ну и плавно пришли к чему прешли...

по сцепке, расцепке еще вникаю, в общех чертах да, но вот эти +n -n   всегда промахиваюсь), кароч раздел VBA Excel. Работа с текстом (функции)
Изменено: mihail_ms - 17.02.2022 23:43:21
Изменить фрагменты текста и сцепить их обратно
 
дай Бог Вам здоровья,
в будущем постараюсь придумать имена переменным более разнообразные и креативные, сейчас менять  не надо, а то совсем запутаюсь(возможно не только я)
в принципе оно, но все равно не работает))) выдает как и было, начал разбираться не работает замена

метод 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(где,что, на что)

P/s/ я не здаюсь, буду пробовать дальше...
Изменить фрагменты текста и сцепить их обратно
 
насколько читал переменную можно объявлять сколь угодно раз,  актуально последнее, по этому думал aSpl  в 1й раз масив, что бы в нем вычленить хвостик, а второй раз как сам хвостик, ну ок, ввел\изменил на еще одну переменную aSplf(есть подозрение, что половину можно не объявлять, но для наглядности и пошаговости без этого пока не куда)

сам код в сообщении 3
Изменить фрагменты текста и сцепить их обратно
 
, че то не пойму,  по коду он берет текст ячейки, разбивает по запятой с пробелом, в этих кусках ищет и меняет майку на фуфайку, если нашел меняет, если не нашел втавляет без изменений , я правильно его понял? с 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
Изменено: mihail_ms - 17.02.2022 21:53:41
Изменить фрагменты текста и сцепить их обратно
 
Допустим я хочу поменять часть текста в ячейках
Код
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)?
Замена в фрагментах текста с перебором заменяемых слов
 
Дмитрий(The_Prist) Щербаков , ну уточнение я давал в 11 сообщении. Про i понял, оно ни на что не влияет....

По Вашему коду до меня дошло, что Х = это переменная масива букв, т.е. можно обьявить еще оду переменную с цифрами и комбинировать их. А тот же массив может содержать не только "А", но и например выражение "АА", правильно? Спасибо, буду пробывать, извените за косноязычие , если что. Считайте, что я гуманитарий )))
А я то думал, что Х это цифры от 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. Про  Регулярки слышал. Не люблю функции и доп столбцы, люблю кнопки)))
Цитата
Дмитрий(The_Prist) Щербаков
Ваш код увы отрабатывает не верно, убивает все пробелы, но оно и по коду мне не видно,  Selection.Replace x & " ", x  где указана АБВ, и как ее задействовать, на удивление код с i убивает только пробелы между цифрой и буквой, а между цифрой/цифрой или буквой/буквой не трогает...
Изменено: mihail_ms - 04.02.2022 14:12:58
Замена в фрагментах текста с перебором заменяемых слов
 
Код на листе 1, в комментарии кода, моя попытка с ошибкой, вероятно я не догоняю, но почему оно работает?.  
Замена в фрагментах текста с перебором заменяемых слов
 
Добрый, попалась гадкая таблица для анализа и сравнения, но проглядывалась некая система, между цифрами в конце пробел, а должен быть символ. Ну я как програмист мягко говоря не очень, но думаю по идее замены макрорекодер пишет, попробую. На удивление сработало. Х и У тут отдельно, т.к. мне кажется что только Х отработает 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
ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 
, да все хорошо, обычно искать не более 200 строк в 50000, думаю агрегат самое то, не надо ctrl+shift+enter юзать.
ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 
, с майнерами мне все равно не сравниться.
так то агрегатор я ес-но поправлю с D:D на D2:D99999

А с впр "*, Ростов*" , этот момент я тоже осознаю, и учитываю при ручной проверке, просто на радостях не акцентировал внимание, все зависит от структуры таблитцы и ее логики, например осле Ростов может быть пробел или зпт, а так же он может быть Великим...
ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 
Цитата
написал:
сделаем планету ( я про землю) теплее  
Наполним небо добротой
ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 

Короче решил через ВПР со *, т.е  то что ищем подтягиваем через впр, и по сути в агрегате он подставляет то, что надо. В моем случае как бы оно...

=АГРЕГАТ(15;6;'лист1'!I:I/('лист1'!D:D=ВПР("*, Ростов*"&B2;'лист1'!D:D;1;));1)

ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 
tutochkin,спасибо за уточнение, т.е он * воспринимает как *, а ни как ЧТОУГОДНОТУТ.
Уже направление, пошел пробывать...
ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 
, Ну как то примерно так.
Изменено: mihail_ms - 06.12.2021 12:38:29
ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 
Цитата
написал:
Так научитесь.
Легко сказать... может я гуманитарий...

А вообще если к поиску добавлять "*текст*", то без * , работает, а с * выдает #число.
А победа казалась так близка, в моем случае то, где ищем выглядит "какойнибудьтекстразное кол-вознаков,Ростов-на-Дону,какойнибудьтекстразное кол-вознаков,искомое в ячейках c1,с2 и т.д), соответственно ищу "*Ростов-на-Дону*"&c1  и т.п.
Изменено: mihail_ms - 06.12.2021 12:11:00
ВПР минимальной даты или Аналог функции МИНЕСЛИ в офисе до 2019
 
, тут есть несколько "НО"
1. Я глуповат и не умею
2. Я глуповат и буду оч. долго этому учиться, курить полностью язык для сложно, я как обезьянка по аналогии, мне быстрее вставить/написать формулу, протянуть ее и если надо сохранить как значение
3. Макрос формирует некую таблицу с формулами, где я проверяю глазами адреса, и вот адреса могут быть записаны как корпус, строение, /, \, корп.  ну и т.д. я их конечно привожу к общему виду, но все учесть невозможно, так вот в этом промежуточном этапе я могу подправить адрес, а формулы обновятся и подтянут...
Страницы: 1 2 3 4 5 6 След.
Наверх