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

Страницы: 1
Склейка большого количества ячеек по условию
 
#
20.04.2021 22:35:21
Цитата
Mershik написал:
INDRUSPBH015009
столбец BD
 
Перейти    
Склейка большого количества ячеек по условию
 
#
20.04.2021 21:58:21
Да нет, таблица лютая. Сейчас пытаюсь что-то наваять.
 
Перейти    
Склейка большого количества ячеек по условию
 
#
20.04.2021 21:37:55
Привет. Какой способ рекомендуете?
 
Перейти    
Склейка большого количества ячеек по условию
 
#
20.04.2021 21:32:03
Добрый вечер,

Вообщем задача склеить текст из ячеек по условию отмеченных "да" в таблице.
Условия на данный момент со столбцов А до BC.

Можно использовать мега длинную конструкцию из "ЕСЛИ", но т.к. в определенный момент понял, что количество столбцов условий стремится к бесконечности...
Конечный вариант в ячейке столбца BF, на данный момент INDRUSPBH015009.

Подскажите что-то более удобное и живое, пожалуйста.
 
Перейти    
VBA цикл загрузки с URL
 
#
12.07.2020 14:22:31
Код
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub GetTheTextContainer()

    Dim i As Integer
    Dim TWW As Worksheet: Set TWW = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    i = 0
    TWW.Range("D1:J50").ClearContents


Set IE = CreateObject("InternetExplorer.Application"):     ' çàãðóæàåì áðàóçåð Internet Explorer
    On Error Resume Next
    Adrs = Range("A51")    ' óêàçûâàåì àäðåñ ñàéòà (âåá-ñòðàíèöû íàõîäèòñÿ â «A1»), òåêñò êîòîðîé çàãðóæàåì
    IE.Navigate Adrs    ' çàãðóæàåì ñàéò
    While IE.busy Or (IE.readyState <> 4): Sleep 1000: DoEvents: Wend    ' æäåì, ïîêà çàãðóçèòñÿ ñòðàíèöà
    Sleep 1000
    Do While i < 50
    text = IE.Document.getElementsByClassName("container")(i).outerText
    
    TWW.Cells(i + 1, 1).Value = text
    TWW.Cells(52, 1).Value = i
    Sleep 10
    i = i + 1      
Loop
          
        TWW.Range("A1:A50").TextToColumns Destination:=TWW.Range("D1:J50"), _
        DataType:=xlDelimited, TextQualifier:=xlNone, Space:=True, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1 _
        ), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
     
     Application.DeleteObject ("InternetExplorer.Application")
     Application.CutCopyMode = False
     
End Sub

Такой код получился.
Но:
1. Будет ли работать DeleteObject, что-то не пойму, в трее приложения (исправил) висят, и нагрузка на процессор растет. Как очистить память? -РЕШЕНО-
2. Все равно просит подтверждения замены данных, хотя ячейки пустые. -РЕШЕНО-
3. Возможно срау стоит разбивать и ложить в ячейки значения.
 
Перейти    
VBA цикл загрузки с URL
 
#
11.07.2020 17:42:46
Странное дело, дружище.

текст по столбцам из скрипта работает только при активном Sheet1. Что-то у меня оба полушария вошли в клинч... пока нет идей.
 
Перейти    
VBA цикл загрузки с URL
 
#
11.07.2020 15:08:31
Привет. Оптимизировал. При выполнении просит заменить данные, как это сделать в автоматическом режиме?
Код
Sub GetTheTextContainer()

    Dim i As Integer
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    i = 0


Set IE = CreateObject("InternetExplorer.Application"):     
    On Error Resume Next
    'URLs = Range("A1")    
    IE.Navigate URLs 
    While IE.busy Or (IE.readyState <> 4): DoEvents: Wend    
    Sleep 1000
    Do While i < 100
    text = IE.Document.getElementsByClassName("container cleared")(i).outerText
    
    ws.Cells(i + 1, 1).Value = text

    i = i + 1
    
    ws.Cells(1, 2).Value = i
    
   Loop
     
     ThisWorkbook.Worksheets("Sheet1").Range("A1:A100").Select
        Selection.TextToColumns Destination:=ActiveCell.Offset(0, 3).Range("A1"), _
        DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=False _
        , Tab:=False, Semicolon:=False, Comma:=False, Space:=True, Other:= _
        False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1 _
        ), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
     
End Sub
Изменено: VVR - 11.07.2020 15:08:56
 
Перейти    
VBA цикл загрузки с URL
 
#
11.07.2020 13:23:15
Код
Sub GetTheTextNontainer()

    Dim i As Integer
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    i = 0


Set IE = CreateObject("InternetExplorer.Application"):    
    On Error Resume Next
    'URLs = Range("A1")    
IE.Navigate URLs    
While IE.busy Or (IE.readyState <> 4): DoEvents: Wend   
    Sleep 1000
    Do While i < 100
    text = IE.Document.getElementsByClassName("container cleared")(i).outerText
    
    ws.Cells(i + 1, 1).Value = text

    i = i + 1
    
    ws.Cells(1, 2).Value = i
    
   Loop
     
End Sub


Нужно начинать с 1

Но загрузка, капц, долгая. И в конце выходит с ошибкой. Как определить последний элемент "container" и закончить обработку?
Сontainer составное число в текстовом формате, можно ли его как-то разложить по ячейкам?

Наверное не логично каждый цикл грузить вебстраницу...
Изменено: VVR - 11.07.2020 14:09:37
 
Перейти    
VBA цикл загрузки с URL
 
#
11.07.2020 09:57:13
Код
Sub GetTheText()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    With CreateObject("internetexplorer.application")
        .Navigate sURL
             text = .Document.getElementsByClassName("container")(0).outerText
        .Quit
    End With

    ws.Cells(1, 1).Value = text
End Sub

Добрый день,

Выше код, все работает. Но как заполнить ячейки столбца по нахождению всех элементов класса container?
Изменено: VVR - 11.07.2020 10:16:03
 
Перейти    
Страницы: 1
Наверх