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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 19 След.
Power Query веб выгрузка, мультистраничная выгрузка из интернета, выгружает не все данные (только первых 100 строк)
 
Здравствуйте
Код
= Web.Page(Text.Replace(Text.FromBinary(Web.Contents("https://www.interlak-expo.ru/ru/exhibition/exhibitors/"),1251),"$('#example').DataTable","//$('#example').DataTable")){[Id="example"]}[Data]
Подсчет уникальных участников по двум критериям
 
Здравствуйте
Что-то типа
Код
=ArrayFormula(Rows(UNIQUE(Query(FLATTEN(IF((MONTH($G$2:$AO$2)=MONTH(G$2))*$G$6:$AO$23;$D$6:$D23;));"select Col1 where Col1<>''";1))))
Импортировать нетабличные данные через Power Query
Форма ввода логина/пароля (CredUIPromptForWindowsCredentials + CredPackAuthenticationBuffer)
 
Доброго времени суток. Пишу форму запроса логина/пароля в VBA, никак не могу вывести форму с предварительно заполненным именем пользователя. Подскажите, пожалуйста, что не так, что забыл
Код
Option Explicit
 
#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare PtrSafe Function CredUIPromptForWindowsCredentials Lib "credui" Alias "CredUIPromptForWindowsCredentialsW" (ByRef pUiInfo As CREDUI_INFO, ByVal dwAuthError As Long, ByRef pulAuthPackage As LongPtr, ByRef pvInAuthBuffer As Any, ByVal ulInAuthBufferSize As Long, ByRef ppvOutAuthBuffer As Any, pulOutAuthBufferSize As Long, ByRef iSave As Long, ByVal dwFlags As Long) As Long
    Private Declare PtrSafe Function CredUnPackAuthenticationBuffer Lib "credui" Alias "CredUnPackAuthenticationBufferW" (ByVal dwFlags As Long, ByVal pAuthBuffer As LongPtr, ByVal cbAuthBuffer As Long, ByVal pszUserName As LongPtr, ByRef pcchMaxUserName As Long, ByVal pszDomainName As LongPtr, ByRef pcchMaxDomainName As Long, ByVal pszPassword As LongPtr, ByRef pcchMaxPassword As Long) As Long
    Private Declare PtrSafe Function CredPackAuthenticationBuffer Lib "credui" Alias "CredPackAuthenticationBufferA" (ByVal dwFlags As Long, ByRef pszUserName As Any, ByRef pszPassword As Any, ByRef pPackedCredentials As Any, ByRef pcbPackedCredentials As Long) As Long
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function CredUIPromptForWindowsCredentials Lib "CredUI" Alias "CredUIPromptForWindowsCredentialsW" (ByRef pUiInfo As CREDUI_INFO, ByVal dwAuthError As Long, ByRef pulAuthPackage As Long, ByVal pvInAuthBuffer As Any, ByVal ulInAuthBufferSize As Long, ByRef ppvOutAuthBuffer As Any, pulOutAuthBufferSize As Long, ByRef iSave As Long, ByVal dwFlags As Long) As Long
    Private Declare Function CredUnPackAuthenticationBuffer Lib "CredUI" Alias "CredUnPackAuthenticationBufferW" (ByVal dwFlags As Long, ByVal pAuthBuffer As Long, ByVal cbAuthBuffer As Long, ByVal pszUserName As Long, ByRef pcchMaxUserName As Long, ByVal pszDomainName As Long, ByRef pcchMaxDomainName As Long, ByVal pszPassword As Long, ByRef pcchMaxPassword As Long) As Long
    Private Declare Function CredPackAuthenticationBuffer Lib "credui" Alias "CredPackAuthenticationBufferW" (ByVal dwFlags As Long, ByRef pszUserName As Any, ByRef pszPassword As Any, ByRef pPackedCredentials As Any, ByRef pcbPackedCredentials As Long) As Long
#End If
Private Type CREDUI_INFO
    cbSize As Long
    #If VBA7 Then
        hwndParent As LongPtr
        pszMessageText As LongPtr
        pszCaptionText As LongPtr
    #Else
        hwndParent As Long
        pszMessageText As Long
        pszCaptionText As Long
    #End If
    hbmBanner As Long
End Type
 
Public Sub GetCred()
    
    Dim pUiInfo As CREDUI_INFO
    
    Dim pulOutAuthBufferSize As Long
    Dim pulInAuthBufferSize As Long
    
    #If VBA7 Then
        Dim ppvOutAuthBuffer As LongPtr
        Dim ppvInAuthBuffer As LongPtr
    #Else
        Dim ppvOutAuthBuffer As Long
        Dim ppvInAuthBuffer As Long
    #End If
    
    
    Dim ret&, b() As Byte, InAuthBuffer() As Byte
    Dim s1$, s2$
    pUiInfo.cbSize = LenB(pUiInfo)
    pUiInfo.hwndParent = 0
    
    s1 = "Необходимо ввести учетные данные"
    s2 = "Подключение"
    pUiInfo.pszMessageText = StrPtr(s1)
    pUiInfo.pszCaptionText = StrPtr(s2)
    
    ret = CredPackAuthenticationBuffer(4, sUserName, vbNullString, Empty, pulInAuthBufferSize)
    ReDim InAuthBuffer(pulInAuthBufferSize)
    ret = CredPackAuthenticationBuffer(4, sUserName, vbNullString, InAuthBuffer(0), pulInAuthBufferSize)
    ret = CredUIPromptForWindowsCredentials(pUiInfo, Empty, Empty, InAuthBuffer(0), pulInAuthBufferSize, ppvOutAuthBuffer, pulOutAuthBufferSize, Empty, &H20 Or &H200)
    
    If ret = 0 Then
        'CredUnPackAuthenticationBuffer
    End If
End Sub

Кросс
Qwery, работа с процентами
 
как вариант
Код
    Source = 
        Odbc.Query(
            "DSN=Excel Files;DBQ=C:\Users\user\Downloads\Прим.xlsb;DriverId=1046", 
            "Select * from `Sheet1$`"
        )
или, если нужно без заголовков,
Код
    Source = 
        List.Accumulate(
            {"12","14","15","16"},
            null,
            (acc,ver)=>if acc is table 
                then acc 
                else 
                    try 
                        Table.Buffer(OleDb.Query(
                            "Provider=Microsoft.ACE.OLEDB."&ver&".0;Data Source=C:\Users\user\Downloads\Прим.xlsb;Extended Properties=""Excel 12.0;HDR=NO""", 
                            "Select * from `Sheet1$`"
                        )) 
                    otherwise null
        )
Как с помощью Индекса и функции Наименьший вывести все варианты по условию
 
О как, ну хоть бы уведомили об удалении, а то подумал, что не отправил и написал еще раз...
Найти количество дней в указанных интервалах за вычетом конкретных дат, если они входят в эти интервалы.
 
Цитата
RAN написал:
krosav4ig
ага :)
Найти количество дней в указанных интервалах за вычетом конкретных дат, если они входят в эти интервалы.
 
Сергей Евдокимов, а + перед диапазоном в формуле преобразует ссылку на диапазон в массив значений.
Найти количество дней в указанных интервалах за вычетом конкретных дат, если они входят в эти интервалы.
 
Как-то так
Код
=СУММПРОИЗВ(ЧИСТРАБДНИ.МЕЖД(+B2:D2;+B3:D3;"0000000";A7:A27))
Интервалы дат в динамический массив дат. Одной формулой. На лету.
 
Список уникальных, вдруг кому пригодится
Код
=НАИМЕНЬШИЙ(ЕСЛИОШИБКА(ЧАСТОТА(--ТЕКСТ(ТЕКСТ(ОСТАТ(СТОЛБЕЦ(A:S);2)*СТРОКА(ИНДЕКС(A:A;МИН(2:2)):ИНДЕКС(A:A;МАКС(2:2)));"[>="&A2:S2&"]0;1\E9");"[<="&B2:T2&"]0;1\E9");СТРОКА(ИНДЕКС(A:A;МИН(2:2)):ИНДЕКС(A:A;МАКС(2:2))))^0*СТРОКА(ИНДЕКС(A:A;МИН(2:2)):ИНДЕКС(A:A;МАКС(2:2)));"");СТРОКА(A1:ИНДЕКС(A:A;МАКС(2:2)-МИН(2:2)+1)))
неравенство с отрицательными числами в формуле
 
Код
=F3*ВПР(ABS(F3);{0;0:1E6;3:25E5;5}%;2)
Интервалы дат в динамический массив дат. Одной формулой. На лету.
 
чуть покороче
Код
=НАИМЕНЬШИЙ(ЕСЛИОШИБКА(ЕСЛИ(ОСТАТ(СТОЛБЕЦ(A2:T2);2);--ТЕКСТ(ТЕКСТ(СТРОКА(A1:ИНДЕКС(A:A;МАКС(A2:T2)-МИН(A2:T2)+1))+МИН(A2:T2)-1;"[>="&A2:S2&"]0;");"[<="&B2:T2&"]0;");"");"");СТРОКА(A1:ИНДЕКС(A:A;СУММ((B2:T2-A2:S2+1)*ОСТАТ(СТОЛБЕЦ(A2:S2);2)))))
Консолидация в Power Query. Собрать данные диапазона со всех листов в одну таблицу
 
Добрый вечер.
Как вариант
Код
let
    Source =
        File.Contents(Excel.CurrentWorkbook(){[Name="FilePath"]}[Content]{0}[Column1]),
    Sheets = 
        Table.SelectRows(
            Excel.Workbook(Source,null,true),
            each [Kind]="Sheet" and 
                (try Date.From([Name]) otherwise null)<>null
        )[Data],
    Transform =
        List.Transform(Sheets, each let
            fn = 
                each List.Count(List.RemoveNulls(Record.FieldValues(_))),
            fn1 = 
                each Table.LastN(Table.RemoveLastN(_, each fn(_)=0), each fn(_)>0),
            Table = 
                Table.Transpose(fn1(Table.Transpose(fn1(_)))),
            Promoted = 
                Table.PromoteHeaders(Table.Skip(Table,1))
        in Promoted),
    Combined = 
        Table.Combine(Transform)    
in
    Combined
Изменено: Андрей Лящук - 18.12.2021 17:17:34
Замена или удаление части текста в редакторе Power Query
 
Доброго времени суток
До кучи
Код
let
    Source = 
        List.Buffer(Lines.FromBinary(Web.Contents("https://www.rotowire.com/basketball/player.php?id=2502"))),
    fn = (src, tag, class, fn_)=> let
        pos = 
            List.PositionOf(src, class, 3, (a,b)=>Text.Contains(a,b)),
        fx = (s,tag) =>
            List.Count(Text.Split(s,"<"&tag))-List.Count(Text.Split(s,"</"&tag&">")),
        gen = 
            List.Transform(
                pos,
                each List.Generate(
                    ()=>[i=_,j=0,d=fx(src{i},tag)],
                    each [d]>0 or [j]=0,
                    each [i=[i]+1,j=[j]+1,d=[d]+fx(src{i},tag)], 
                    each src{[i]}
                )
            ),
        ret = 
            List.Transform(gen,each fn_(Web.Page(Text.Combine(_))[Data]{0}[Children]{0}{[Name="BODY"]}[Children]{0}))
    in ret,
    init = 
        [
            headers = {"Status","News","Analysis"}, 
            enities = {
                [tag="div",class="news-update__playerhead",callback=each [Children]{0}[Children]{0}[Text]],
                [tag="div",class="news-update__news",callback=each [Children]{0}[Text]],
                [tag="div",class="news-update__analysis",callback=
                    each let 
                        Prepared=Table.ReplaceValue([Children],null,each [Children]{0}[Text],Replacer.ReplaceValue,{"Text"})[Text] 
                    in Text.Combine(List.Skip(Prepared,2))
                ]
            }
        ],
    Result =
        Table.FromColumns(List.Transform(init[enities], each fn(Source, [tag], [class], [callback])),init[headers])
in
    Result
Изменено: Андрей Лящук - 17.12.2021 23:02:12
Импорт нетабличных данных по URL (Power Query)
 
Доброго времени суток.
Цитата
Максим Бугриев написал:
нажимаешь на шестеренку и в поле открыть файл как, выбираешь "Текстовый файл", и уже с этими данными в PQ делаешь все что нужно.
ну так же не интересно

для работы запроса необходимо выполнить слияние ключей реестра из этого поста
Код
let
    url = 
        "https://baraholka.onliner.by/viewforum.php?f=608&start0",
    Source =  
        Web.Page("<script>
            try {
                d = document;
                let w = window.open('', '_blank'),
                wnd = new ActiveXObject('Shell.Application').windows(),
                ie = wnd.Item(wnd.count - 1);
                ie.navigate('"&url&"');
                while (ie.LocationURL !== '"&url&"' ? true : ie.Document.readyState !== 'complete') {}
                let $ = ie.Document.parentWindow.jQuery.noConflict();
                const fn=function(itm,selector,fx) {try {return fx($(itm).find(selector)[0]);} catch (err) {return null;}};
                d.write(
                    JSON.stringify($('.ba-tbl-list__table > tbody > tr:not(:has(.banner-helper-wrapper)):not(:has(th))')
                    .map(function(i, itm) {
                        return {
                            'img' : fn(itm,'.ph img',function(a) {return a.src;}),
                            'label' : fn(itm,'.ba-label',function(a) {return a.className.split('-').slice(-1)[0];}),
                            'caption' : fn(itm,'h2 a',function(a) {return a.text;}),
                            'href' : fn(itm,'h2 a',function(a) {return a.href;}),
                            'description' : fn(itm,'.ba-description',function(a) {return a.innerText;}),
                            'location' : fn(itm,'.ba-signature strong',function(a) {return a.innerText;}),
                            'user' : {
                                'name' : fn(itm,'.ba-signature a',function(a) {return a.text;}),
                                'href' : fn(itm,'.ba-signature a',function(a) {return a.href;})
                            },
                            'price' : {
                                'primary' : fn(itm,'.price-primary',function(a) {return parseFloat(a.innerText);}),
                                'torg' : fn(itm,'.cost-torg',function(a) {return a.innerText;})
                            }
                        };
                    }).toArray())
                )
                ie.Application.Quit();
            } catch (e) {
                d.write('<table><tr><th>error<tr><td>' + e.message)
            }
            delete d;
        </script>"),
    Data = 
        Table.FromRecords(Json.Document(Source{0}[Data]{0}[Children]{[Name="BODY"]}[Children][Text]{0}))
in
    Data
Power Query извлечь данные СSS HTML
 
чего-то я совсем про эту тему позабыл ...
собственно, те самые пляски с бубномjQuery, во вложении 2 reg файла для внесения необходимых для работы запроса изменений в реестр, и батник для снятия бэкапа перед изменением реестра. Если пользователь обладает правами администратора то должно быть достаточно импорта файла HKCU IE11.reg , иначе придется импортировать файл HKLM IE11.reg из-под администратора
Код
// Запрос1
let
    url    = "https://meteoinfo.ru/forecasts/russia/vologda-area/vologda",
    Source =  Web.Page("<script>
                  try {
                      d = document;
                      let w = window.open('', '_blank'),
                          wnd = new ActiveXObject('Shell.Application').windows(),
                          ie = wnd.Item(wnd.count - 1);
                      ie.navigate('"&url&"');
                      while (ie.LocationURL !== '"&url&"' ? true : ie.Document.readyState !== 'complete') {}
                      let $ = ie.Document.parentWindow.jQuery.noConflict();
                      $('.fc_short_img').replaceWith(function() {
                          return this.title
                      });
                      $('.fc_small_gorizont_ww span').replaceWith(function() {
                          return this.title + this.innerText
                      });
                      d.write($('.fc_tab_1')[0].outerHTML);
                      ie.Application.Quit();
                  } catch (e) {
                      d.write('<table><tr><th>error<tr><td>' + e.message)
                  }
                  delete d;
              </script>"){0}[Data],
    Custom1 = Table.ReplaceValue(Source,{"День","Ночь"},"Характер погоды",(a,b,c)=>if List.Contains(b,a) then c else a,{"Column1"}),
    Custom2 = Table.FromColumns({{"Время суток"}&List.Combine(List.Transform({"День","Ночь"},each List.Repeat({_},5)))}&Table.ToColumns(Custom1)),
    Custom3 = Table.PromoteHeaders(Custom2, [PromoteAllScalars=true]),
    Custom4 = Table.RenameColumns(Custom3,{{"", "Показатель"}}),
    Custom5 = Table.UnpivotOtherColumns(Custom4, {"Время суток", "Показатель"}, "Дата", "Значение"),
    Custom6 = Table.TransformColumns(Custom5,{{"Дата", each Date.FromText(Text.AfterDelimiter(_,"#(cr,lf)")), type date}})
in
    Custom6
Power Query извлечь данные СSS HTML
 
Цитата
Андрей VG написал:
Привет, тёзка.А что мешает использовать jQuery в Power Query?
Добрый день, ну я это и имел ввиду, утром мозг еще спит, не совсем корректно мыслю выразил
Power Query извлечь данные СSS HTML
 
Если очень надо, то можно преобразовать эти элементы в необходимый текст с помощью jQuery до передачи в Power Query. Единственное, могут потребоваться права администратора для внесения изменений в реестр.
Selenium работа с Chrome
 
У меня с этой версией нормально дружит драйвер 88.0.4324.96. Вы в какую папку драйвер кладете?
как вариант, можно использовать .Net сборку,  но часть методов при данном подходе может быть недоступна
Как сделать нормальную таблицу из XML
 
Добрый день
Excel. Импорт данных XML
Power Query XML Connector
Ищу рабочую socket библиотеку 64 бит
Печать jpg файлов из Excel
 
еще вариант, копируем во временную папку, печатаем все файлы пачкой
Код
Sub PrintFiles()

    Dim sPath As Variant
    Dim sh As Object 'new Shell32.Shell

    Set sh = CreateObject("shell.application")
    
    With sh.Namespace("shell:Local AppData\Temp")
        .NewFolder "jpg"
        With .ParseName("jpg\").GetFolder
            sh.Namespace("shell:RecycleBinFolder").MoveHere .Items(), &H14
            For Each sPath In ActiveSheet.UsedRange.Columns("A").Value
                .CopyHere sh.Namespace(0).ParseName(sPath), &H14
            Next
            .Items().InvokeVerbEx "print"
        End With
    End With
    
End Sub
Изменено: Андрей Лящук - 15.09.2020 10:32:22
Как разбить текст на строки внутри ячейки с помощью Power Query, Добрый день! Сцепить текст из нескольких полей - получается. Но нужно, чтобы текст записался в ячейку в несколько строк
 
и так тоже должно  
Код
Table.AddColumn(table, "column", each Text.Format("#[Предмет]. #(lf)дог. №#[№ дог] от #[ДатаДог]",_))
Как разбить текст на строки внутри ячейки с помощью Power Query, Добрый день! Сцепить текст из нескольких полей - получается. Но нужно, чтобы текст записался в ячейку в несколько строк
 
Код
[Предмет] & ". #(lf)дог. №" & [#"№ дог"] & " от " & Text.From([ДатаДог])
Печать jpg файлов из Excel
 
Цитата
БМВ написал:
mspaint /p
ну так же не интересно :) вот тут намного интереснее :D
PQ Вывести сообщение об отправке данных после вызова процедуры
 
а еще можно так, только если осторожно
Использование столбца таблицы в качестве массива для ИНДЕКС
 
Здравствуйте
Код
=ИНДЕКС([Остаток];СТРОКА()-1-СТРОКА([#Заголовки]))+(-1)^([@[Приход/Расход]]="Расход")*[@Сумма]
На сайте отправить адрес в поле поиска
 
Цитата
Григорий Тимофеев написал:
Возможно ли ориентацию карты сделать по инвентарному номеру?
с этим вопроом вам надо обращаться к разработчикам карты
На сайте отправить адрес в поле поиска
 
Доброго времени суток
для IE
Код
Sub Go_To_Site()
    Dim fn$
    Const BaseUrl$ = "http://map.mossvet.ru:51/"
    With CreateObject("internetexplorer.application")
        .navigate ""
        .document.parentWindow.execScript "document.write(encodeURI('" & [A1] & "'))", "JavaScript"
        GotoUrl .Application, BaseUrl & "AddressDetail.php?Address=" & .document.body.innertext
        fn = "(" & .document.body.querySelector("tr").onclick & ")(0)"
        GotoUrl .Application, BaseUrl
        .document.parentWindow.execScript fn, "JavaScript"
        .Visible = 1
    End With
End Sub
Sub GotoUrl(ByRef ie As Object, url$, Optional timeout% = 5)
    Dim t!
    ie.navigate url
    t = Timer
    Do
        DoEvents
        If Timer - t >= timeout Then
            MsgBox "Timeout!", 16
            Stop
        End If
    Loop Until ie.ReadyState = 4
End Sub
Изменено: Андрей Лящук - 03.09.2020 03:03:35
Долго форматируется таблица через VBA
 
Ну и не помешает проинспектировать список стилей. Избыточное количество стилей может в некоторой мере замедлять работу с файлом Удаление неиспользуемых стилей
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 19 След.
Наверх