Импорт веб-данных в Excel без перезаписи истории

Я импортирую данные в Excel из онлайн-журнала телефона. В основном это выглядит так:

Date        Time    Duration    Local Identity          Number
14.12.2016  11:11   00:03       88821354@192.168.1.2    22252797
14.12.2016  10:33   00:02       88821354@192.168.1.2    25322678

Я успешно импортировал данные в Excel. Однако сам телефонный журнал действительно раздражает тем, что он сохраняет данные только от самого последнего вызова на любой заданный номер. Т.е. если я сделаю звонок на второй номер в списке выше (25322678), я потеряю данные о предыдущем звонке (сделанном в 10:33). И это будет отражено в Excel.

Мне интересно, есть ли способ непрерывно импортировать новые данные без перезаписи старых. Мне кажется, что нет способа сделать это путем настройки параметров импорта, поэтому я рассматриваю различные обходные пути. Я пока не смог придумать что-нибудь, способное на это.

Источник

2 ответа

Решение

Это решение создает рабочий лист с именем "PhoneLog" для хранения накопленных результатов функции "Из Интернета".

В этой процедуре предполагается, что результаты функции "Из Интернета" находятся в рабочей области с именем "WebFrom" в диапазонеA:Eначиная с строки1(изменить при необходимости)

Эта процедура должна находиться в той же книге, в которой хранятся результаты функции"Из Интернета".

Выполните эту процедуру в первый раз перед обновлением функции "Из Интернета", чтобы добавить фактические результаты в "PhoneLog". После этого запустите эту процедуру сразу после функции"Из Интернета".

Эта процедура создает лист "PhoneLog", если он не найден в книге. Затем он добавляет в "PhoneLog" все новые записи из таблицы "WebFrom"(при необходимости изменяйте).

Option Explicit

Sub Phone_Log()
Const kWebFrom As String = "WebFrom"    'change as required
Const kPhoneLog As String = "PhoneLog"  'change as required
Dim wshWeb As Worksheet, wshLog As Worksheet
Dim blwshNew As Boolean
Dim rWeb As Range, rLog As Range
Dim aWeb As Variant, vItm As Variant
Dim lRow As Long, l As Long

    Rem Set Worksheets
    With ThisWorkbook
        Set wshWeb = .Worksheets(kWebFrom)
        On Error Resume Next
        Set wshLog = .Worksheets(kPhoneLog)
        On Error GoTo 0
        If wshLog Is Nothing Then
            blwshNew = True
            Set wshLog = .Worksheets.Add(After:=wshWeb)
            wshLog.Name = kPhoneLog
    End If: End With

    Rem Set FromWeb Array
    With wshWeb
        If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
        Set rWeb = .Cells(1).CurrentRegion
    End With
    With rWeb
        .AutoFilter Field:=1, Criteria1:="<>"
        Set rWeb = .Cells.SpecialCells(xlCellTypeVisible)
        aWeb = .Offset(1).Resize(-1 + .Rows.Count).SpecialCells(xlCellTypeVisible).Value2
        .AutoFilter
    End With

    Rem Set Log Array
    With wshLog
        If blwshNew Then
            Rem Set Log - First Time
            rWeb.Copy
            .Cells(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
            .Cells(1).CurrentRegion.Columns.AutoFit

        Else
            Rem Add New Records into Log Range
            Set rLog = .Cells(1).CurrentRegion
            With rLog
                lRow = .Rows.Count
                For l = 1 To UBound(aWeb)
                    vItm = WorksheetFunction.Index(aWeb, l, 0)

                    'Use this line if running the "FromWeb" function for one IP address only
                    'If WorksheetFunction.CountIfs(.Columns(1), vItm(1), _
                        .Columns(2), vItm(2), .Columns(5), vItm(5)) = 0 Then
                    'Use this line if running the "FromWeb" function for several IP addresses
                    If WorksheetFunction.CountIfs(.Columns(1), vItm(1), _
                        .Columns(2), vItm(2), .Columns(4), vItm(4), .Columns(5), vItm(5)) = 0 Then

                        lRow = 1 + lRow
                        .Rows(lRow).Value = vItm
            End If: Next: End With

            Rem Format Log Range
            Set rLog = .Cells(1).CurrentRegion
            With rLog
                .Rows(2).Copy
                .Offset(1).Resize(-1 + .Rows.Count).PasteSpecial Paste:=xlPasteFormats
                Application.CutCopyMode = False
                .Columns.AutoFit
            End With

            Rem Sort Log Range
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=rLog.Columns(1), SortOn:=xlSortOnValues, _
                    Order:=xlDescending, DataOption:=xlSortNormal
                .SortFields.Add Key:=rLog.Columns(2), SortOn:=xlSortOnValues, _
                    Order:=xlDescending, DataOption:=xlSortNormal
                'Use also this line if running the "FromWeb" function for several IP addresses
                .SortFields.Add Key:=rLog.Columns(4), SortOn:=xlSortOnValues, _
                    Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rLog
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply

    End With: End If: End With

End Sub

Предлагаем прочитать следующие страницы, чтобы глубже понять используемые ресурсы:

Объекты Excel, For Each... Next Statement, If... Then... Else Statement,

В операторе ошибки

Объект Range (Excel), Свойство Range.CurrentRegion (Excel), Свойство Range.Offset (Excel),

Метод Range.PasteSpecial (Excel), Метод Range.SpecialCells (Excel),

Использование массивов, переменных и констант, с оператором, объектом книги (Excel),

Свойство Worksheet.AutoFilter (Excel), Свойство Worksheet.Sort (Excel),

WorksheetFunction Object (Excel).

Источник

Копировать старые данные, Обновить, Копировать новые данные, Удалить дубликаты

Я мог бы использовать этот подход:

  1. Перед каждым новым обновленным запросом я копировал бы существующие данные в какой-то лист "Все данные".
  2. Обновить запрос из Интернета
  3. Скопируйте новые данные из шага 2 на лист "Все данные", добавьте внизу.
  4. Удалить дубликаты.

Альтернативы: HTTP-запрос или Internet Explorer.

Рассмотрим вместо функции импорта данных в Excel использование HTTP-запроса для получения текста ответа. Или вы можете перейти на сайт с помощью объекта Internet Explorer.

Затем вы можете назначить текст ответа HTMLDocument и получить необходимые данные. Или вы можете использовать регулярное выражение, чтобы извлечь его.

Затем вы можете либо импортировать все данные и впоследствии удалить дубликаты, либо вы можете сканировать перед импортом, чтобы увидеть, не существует ли запись, и импортировать ее только тогда.

Источник
Другие вопросы по тегам