Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » OSA913
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 След.
Получить html код элемента
 
#
17.10.2021 22:58:42
Да, это помогло хотя и не совсем по теме), спасибо. В процессе поиска натыкался на getElementsByTagName метод, но приделать его к своему коду не получилось. Вопрос пока открыт.
 
Перейти    
Получить html код элемента
 
#
17.10.2021 19:49:57
Функция отлично работает, но там слишком много кода. т.к. он универсален. Чтобы вычленить от туда именно ту часть кода, которая нужна только для моего вопроса, мне потребуется много времени. Подскажите пожалуйста каким методом можно реализовать мою задачу, для общего понимания. Спасибо!
Изменено: vikttur - 17.10.2021 20:21:30
 
Перейти    
Получить html код элемента
 
#
17.10.2021 12:40:45
https://prntscr.com/1whbqif
https://prntscr.com/1whbuvf
 
Перейти    
Получить html код элемента
 
#
17.10.2021 12:28:49
Добрый день! В файле-примере выводится html код страницы сайта. Помогите сделать макрос чтобы выводился не html код страницы, а html код конкретного элемента (блока, контейнера) "head", как на скринах. Спасибо!
Скрытый текст


Код
Function GetHTTPResponse(ByVal sURL As String) As String
 Dim oXMLHTTP As Object
    On Error Resume Next
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", sURL, False
        .send
        GetHTTPResponse = .responseText
    End With
    Set oXMLHTTP = Nothing
End Function

Sub HTML_Text()
Dim Text$
    Text = GetHTTPResponse("https://www.binance.com/en/trade/BTC_USDT?layout=basic")
    ThisWorkbook.Sheets(1).Range("A5") = Text
End Sub
Изменено: OSA913 - 17.10.2021 13:06:53
 
Перейти    
Крипто биржи - парсинг курсов
 
#
10.05.2021 23:24:57
Требуется код для извлечения курсов из списка 28 криптобирж (список в загруженном файле). Бюджет предлагаете вы.
Нужно реализовать таблицей, где в первом столбце-названия бирж, во втором-валюта 1, в третьем-валюта 2, в четвертом-курс. При смене валюты в ячейке второго/третьего столбца и после нажатия на кнопку с макросом должен подгружаться курс.
Изменено: OSA913 - 11.05.2021 01:12:24
 
Перейти    
Извлечь текст из html элемента
 
#
10.05.2021 18:52:29
Спасибо! Как вы определили что именно эта ссылка нужна? Как её можно найти?
 
Перейти    
Извлечь текст из html элемента
 
#
10.05.2021 07:56:53
Привет! Я пытаюсь извлечь текст из элемента, но получаю ошибку на строке с querySelector. Помогите разобраться. Извлекаю курс BTC/USD на бирже ByBit.
HTML:
Код
...
</div>
<span class="chart__head-left--price long">59289.50</span>
</div>
...

VBA:
Код
Dim html As HTMLDocument

    Set html = New HTMLDocument

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.bybit.com/trade/inverse/BTCUSD", False
        .send
        html.body.innerHTML = .responseText
    End With
    Debug.Print html.querySelector("span.chart__head-left--price long").innerText

В теге слово "long" перед цифрами постоянно чередуется со словом "short"
Изменено: OSA913 - 10.05.2021 08:28:17
 
Перейти    
Ссылка на другой лист в формуле УФ если название листа указано в ячейке
 
#
21.05.2020 08:09:00
То, что надо! Благодарю за помощь!
 
Перейти    
Ссылка на другой лист в формуле УФ если название листа указано в ячейке
 
#
20.05.2020 20:17:57
Как в формуле УФ обратиться к листу, если название листа отображено в ячейке?
В формуле 'название листа'! - работает, а 'ячейка с названием' ! - ошибка.
 
Перейти    
Бекап/Импорт отдельных нескольких листов книги
 
#
19.05.2020 12:49:21
Я пробовал так как вы показали, но выскакивает ошибка переменная не определена. Почему так, не смог разобраться.
Файл с "исправленным" кодом приложил.
 
Перейти    
Бекап/Импорт отдельных нескольких листов книги
 
#
19.05.2020 05:49:04
Может кому будет интересно, так сработало:
Код
Sub Import()
Application.ScreenUpdating = False
Dim wsSh, i$
    If MsgBox("Replace?", vbQuestion + vbYesNo, "Import") = vbNo Then
        Exit Sub
    Else
        On Error GoTo Ex
        Workbooks.Open FileName:=Application.GetOpenFilename
        i = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        ThisWorkbook.Sheets(Array(2, 3, 4)).Delete
        GetObject(i).Sheets(Array(1, 2, 3)).Copy After:=ThisWorkbook.Sheets(1)
        GetObject(i).Close
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        ThisWorkbook.Sheets(1).Activate
        MsgBox "Imported!", 64, "Import"
Ex: For Each wsSh In Array(2, 3, 4)
        Sh_Protect Application.ThisWorkbook.Sheets(wsSh)
    Next
    ThisWorkbook.Save
    End If
Application.ScreenUpdating = True
End Sub
Изменено: OSA913 - 19.05.2020 06:00:33
 
Перейти    
Бекап/Импорт отдельных нескольких листов книги
 
#
18.05.2020 11:15:56
Бекап работает, сделал так:
Код
Sub Backup()
Application.ScreenUpdating = False
Dim wsSh, FileName$
If MsgBox("Backup?", vbQuestion + vbYesNo, "Backup") = vbNo Then
        Exit Sub
    Else
        For Each wsSh In Array(2, 3, 4)
            Sh_Unprotect Application.ThisWorkbook.Sheets(wsSh)
        Next
        On Error Resume Next
        FileName = Application.GetSaveAsFilename(".xlsx", "Excel (*.xlsx),", , , Empty)
        If FileName = "False" Then GoTo Ex
        Err.Clear: ThisWorkbook.Sheets(Array(2, 3, 4)).Copy: DoEvents
        If Err Then GoTo Ex
        If ActiveWorkbook.Worksheets.Count = 3 And ActiveWorkbook.Path = "" Then
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            ActiveWorkbook.SaveAs FileName, xlOpenXMLWorkbook
            ActiveWorkbook.DisplayAlerts = True
            Application.EnableEvents = True
            ActiveWorkbook.Close False
            If Err = 1004 Then GoTo Ex
            MsgBox "Created!", 64, "Backup"
        End If
    End If
Ex: For Each wsSh In Array(2, 3, 4)
        Sh_Protect Application.ThisWorkbook.Sheets(wsSh)
    Next
    ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = True
End Sub


Импорт сделал так:
Код
Sub Import()
Application.ScreenUpdating = False
Dim wsSh, i$, j&, k&, l As Byte
    If MsgBox("Replace?", vbQuestion + vbYesNo, "Import") = vbNo Then
        Exit Sub
    Else
        For Each wsSh In Array(2, 3, 4)
            Sh_Unprotect Application.ThisWorkbook.Sheets(wsSh)
        Next
        On Error GoTo Ex
        Workbooks.Open FileName:=Application.GetOpenFilename
        i = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        For l = 2 To 4
            j = ThisWorkbook.Sheets(l).UsedRange.Rows.Count + 1
            k = GetObject(i).Sheets(l - 1).UsedRange.Rows.Count + 1
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            GetObject(i).Sheets(l - 1).Range(Cells(2, 1), Cells(k, 197)).Copy
            Application.DisplayAlerts = True
            Application.EnableEvents = True
            ThisWorkbook.Sheets(l).Activate
            ThisWorkbook.Sheets(l).Range(Cells(2, 1), Cells(j, 197)).ClearContents
            ThisWorkbook.Sheets(l).Range("A2").Select: ActiveSheet.Paste
            l = l + 1
        Next l
        GetObject(i).Close
        ThisWorkbook.Sheets(1).Activate
        Application.Caption = IIf(False = True, Empty, "")
        Application.DisplayStatusBar = False
        MsgBox "Imported!", 64, "Import"
Ex: For Each wsSh In Array(2, 3, 4)
        Sh_Protect Application.ThisWorkbook.Sheets(wsSh)
    Next
    ThisWorkbook.Save
    End If
Application.ScreenUpdating = True
End Sub

Но при импорте если убрать обработчик ошибок, получаю ошибку  1004 "Метод Paste из класса Worksheet завершен неверно". Если после строки
Код
GetObject(i).Sheets(l - 1).Range(Cells(2, 1), Cells(k, 197)).Copy

закрыть файл (GetObject(i).Close), тогда "Paste" работает, но если закрыть в конце цикла, тогда ошибка. А нужно закрыть в конце цикла чтобы скопировались все листы. Как поправить этот момент? Обновленный файл пример приложил.
 
Перейти    
Бекап/Импорт отдельных нескольких листов книги
 
#
18.05.2020 01:00:20
Здравствуйте, в книге 4 листа, у меня есть код, который сохраняет и импортит только 1 лист из книги. Помогите поправить код, что бы был бекап и так же импорт 3х последних листов с сохранением названий этих листов. Файл пример приложил.
Код:
Код
Sub Backup()
Application.ScreenUpdating = False
Dim FileName$
If MsgBox("Backup?", vbQuestion + vbYesNo, "Backup") = vbNo Then
        Exit Sub
    Else
        Application.ThisWorkbook.Sheets(2).Unprotect ("")
        On Error Resume Next
        FileName = Application.GetSaveAsFilename(".xlsx", "Excel (*.xlsx),", , , Empty)
        If FileName = "False" Then GoTo Ex
        Err.Clear: ThisWorkbook.Sheets(2).Copy: DoEvents
        If Err Then GoTo Ex
        If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
            Application.DisplayAlerts = False
            Application.EnableEvents = False
            ActiveWorkbook.SaveAs FileName, xlOpenXMLWorkbook
            ActiveWorkbook.DisplayAlerts = True
            Application.EnableEvents = True
            ActiveWorkbook.Close False
            If Err = 1004 Then GoTo Ex
            MsgBox "Created!", 64, "Backup"
        End If
    End If
Ex: Application.ThisWorkbook.Sheets(2).Protect (""), UserInterfaceOnly:=True
Application.ScreenUpdating = True
End Sub

Sub Import()
Application.ScreenUpdating = False
Dim i$, j&, k&
    If MsgBox("Replace?", vbQuestion + vbYesNo, "Import") = vbNo Then
        Exit Sub
    Else
        Application.ThisWorkbook.Sheets(2).Unprotect ("")
        On Error GoTo Ex
        Workbooks.Open FileName:=Application.GetOpenFilename
        i = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        j = ThisWorkbook.Sheets(2).UsedRange.Rows.Count + 1
        k = GetObject(i).Sheets(1).UsedRange.Rows.Count + 1
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        GetObject(i).Sheets(1).Range(Cells(2, 1), Cells(k, 197)).Copy: GetObject(i).Close
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        ThisWorkbook.Sheets(2).Activate
        ThisWorkbook.Sheets(2).Range(Cells(2, 1), Cells(j, 197)).ClearContents
        ThisWorkbook.Sheets(2).Range("A2").Select: ActiveSheet.Paste
        ThisWorkbook.Sheets(1).Activate
        Application.Caption = IIf(False = True, Empty, "")
        Application.DisplayStatusBar = False
        MsgBox "Imported!", 64, "Import"
Ex:         Application.ThisWorkbook.Sheets(2).Protect (""), UserInterfaceOnly:=True: ThisWorkbook.Save
    End If
Application.ScreenUpdating = True
End Sub
 
Перейти    
Вызвать макрос при изменении ячеек
 
#
17.04.2020 21:50:18
Придумал. Всех благодарю за помощь!
 
Перейти    
Вызвать макрос при изменении ячеек
 
#
17.04.2020 20:53:31
Чтобы в объединённых работало удаление можно что нибудь придумать?
 
Перейти    
Вызвать макрос при изменении ячеек
 
#
17.04.2020 20:38:27
из-за того что ячейки объединены
 
Перейти    
Вызвать макрос при изменении ячеек
 
#
17.04.2020 20:30:00
Не понятно по какой причине в примере работает на удаление значения, а в рабочем файле нет.
 
Перейти    
Вызвать макрос при изменении ячеек
 
#
17.04.2020 20:12:18
skais675, спасибо, а как сделать чтобы макрос сработал при удалении значения? может как то можно условие добавить?
 
Перейти    
Заполнить отдельные элементы VBA массива одним значением
 
#
17.04.2020 19:54:46
Да, цикл подойдёт. Спасибо.

Цитата
БМВ написал:
OSA913 , Вы хоть тайну откройте, в чем идея?
Просто хотел уточнить.
 
Перейти    
Вызвать макрос при изменении ячеек
 
#
17.04.2020 19:23:13
Здравствуйте, помогите с кодом. Нужно чтобы при изменении значения в определённой ячейки в диапазоне срабатывал определённый макрос, и так же чтобы макрос срабатывал когда значение в ячейке удаляется delete-ом.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Union(Cells(2, 37), Range(Cells(4, 38), Cells(16, 38)))) Is Nothing Then
    Select Case Range
        Case Cells(2, 37)
            Call Макрос1
        Case Cells(4, 38)
            Call Макрос2           
        Case Cells(5, 38)
            Call Макрос3
        Case Cells(6, 38)
            Call Макрос4
    End Select
End If
End Sub
 
Перейти    
Заполнить отдельные элементы VBA массива одним значением
 
#
17.04.2020 19:10:14
Есть ли какая нибудь функция типа Union для диапазонов листа, только для элементов VBA массива?
Задача заполнить отдельные элементы массива одним значением в одной строке кода.
 
Перейти    
Назначить горячую клавишу только Ctrl
 
#
24.01.2020 20:49:05
Благодарю за развернутый ответ. Решил оставить все как есть.

Цитата
Дмитрий(The_Prist) Щербаков написал:
Зачем эти все заморочки с кнопочками в каждой ячейке? Что за тяга к созданию себе любимому сложностей?
Кнопочки на защищенном листе защищают ячейки от случайного изменения пользователем значениий в ячейках, что приведет к ошибкам при выполнении некоторых макросов.
Изменено: OSA913 - 24.01.2020 20:51:31
 
Перейти    
Назначить горячую клавишу только Ctrl
 
#
23.01.2020 20:57:14
Ну как бы я хочу не совсем назначить на нее макрос а отключать ее на время выполнения макроса. На листе есть таблица, каждая ячейка в ней-кнопка с макросом, который закрашивает эту ячейку. Задача - чтобы при нажатии кнопки в то время как нажат Ctrl окрашивалась не только одна ячейка, а часть диапазона. Задача эта реализована только с кнопкой Tab, а если в место Tab назначить Ctrl, то при наведении на кнопку с макросом и нажатии Ctrl курсор меняется на стрелку вместо указательного пальца и нажать на кнопку с макросом становится не возможным. Поэтому надо что бы только в данной книге Ctrl не выполнял свою предназначенную excel функцию. он в этой книге вообще не нужен кроме как определять событие этой кнопки.
 
Перейти    
Назначить горячую клавишу только Ctrl
 
#
23.01.2020 04:48:28
Можно назначить макрос только на кнопку контрол? Этим способом:
Код
Private Sub Workbook_Open()
Application.OnKey "{^}", "Макрос"
End Sub

не работает. Подозреваю что кнопку надо как то назначать через WinApi.
 
Перейти    
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
#
15.01.2020 03:16:26
Игорь спасибо за файл, но когда я ввожу в В2 значение, которого нет в Е:Е, ячейка не зеленеет. Это можно исправить добавив в нее второе правило с формулой:
Код
=ЕНД(ПОИСКПОЗ(B2;E:E;))

Но так будет уже два УФ правила на одной ячейке, вопрос можно ли соединить эти формулы, так чтобы они были в одном правиле УФ, и ячейка зеленела когда значения в найденном диапазоне совпадают и когда значение не доступно (Н/Д)?
 
Перейти    
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
#
15.01.2020 02:16:17
"Изменить цвет ячейки если диапазон состоит из определенных значений, или если  значение не доступно (Ошибка #Н/Д)"
 
Перейти    
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
#
14.01.2020 23:09:01
Не могли бы вы приложить файл где есть ячейка с УФ с этим правилом
 
Перейти    
Формула УФ - если в диапазоне присутствуют только некоторые значения
 
#
14.01.2020 21:23:02
Т.е. только могу вводить эту длинную формулу с тремя "СЧЁТЕСЛИМН", нельзя сократить ее как у Игоря, и чтобы она подошла для УФ?
 
Перейти    
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
#
14.01.2020 21:16:49
Хочу первую и вторую формулу вставить в одно правило УФ, чтобы ячейка меняла цвет когда выполняется условие первой формулы или условие второй (ошибка: Н/Д). У меня только работает когда для каждой формулы отдельное правило.
 
Перейти    
Закрасить ячейку, если диапазон не содержит нужного значения или значение не отвечает заданным требованиям
 
#
14.01.2020 06:00:53
Я пробовал с ИЛИ, ЕСЛИОШИБКА и еще с чем то - не дало результата. Премного Благодарен!

Все равно не срабатывает УФ в B4, когда Н/Д
 
Перейти    
Страницы: 1 2 3 4 5 6 7 8 9 След.
Наверх