在 Excel 中导入网络数据而不覆盖历史记录

Import web data in Excel without overwriting history

我正在将在线 phone 日志中的数据导入 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。然而,phone 日志本身真的很烦人,因为它只保留最近一次呼叫任何给定号码的数据。 IE。如果我拨打上面列表中的第二个号码 (25322678),我将丢失上一次通话的数据(在 10:33 拨打)。这将反映在 Excel 中。

我想知道是否有一种方法可以在不覆盖旧数据的情况下持续导入新数据。在我看来,没有办法通过调整导入设置来做到这一点,所以我正在考虑不同的解决方法。不过,我还没有想出任何可以做到这一点的远程方法。

复制旧数据,刷新,复制新数据,删除重复项

我可能会使用这种方法:

  1. 在每个新的刷新查询之前,我会将现有数据复制到一些 "All data" sheet.
  2. 刷新来自 Web 查询
  3. 将步骤 2 中的新数据复制到 "All data" sheet,附加在底部。
  4. 删除重复项。

备选方案:HTTP 请求或 Internet Explorer 导航

考虑使用 HTTP 请求 获取 响应文本 而不是 Excel 导入数据功能。或者您可以使用 Internet Explorer 对象导航到该站点。

然后您可以将 Response Text 分配给 HTMLDocument 并获取您需要的数据。或者你可以使用一些正则表达式来提取它。

那么您可以导入所有数据,然后删除重复项,也可以在导入前扫描,查看是否存在该记录,然后再导入。

此解决方案创建一个名为 “PhoneLog” 的工作表来保存 "From web" 函数的累积结果。

此过程假定 "From web" 函数的结果位于名为 “WebFrom” 的工作表中A:E 从第 1 行开始 (根据需要更改)

此过程必须位于包含 "From web" 函数结果的同一工作簿中。

运行本程序第一次before更新"From web"函数以便添加实际结果为"PhoneLog"。此后 运行 此过程紧跟在 "From web" 函数之后。

如果在工作簿中找不到,此过程将创建 “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 Objects, For Each...Next Statement, If...Then...Else Statement

On Error Statement, Option Explicit Statement,

Range Object (Excel), Range.CurrentRegion Property (Excel), Range.Offset Property (Excel),

Range.PasteSpecial Method (Excel), Range.SpecialCells Method (Excel),

Using Arrays, Variables & Constants, With Statement, Workbook Object (Excel),

Worksheet.AutoFilter Property (Excel), Worksheet.Sort Property (Excel),

WorksheetFunction Object (Excel).