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

Question

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

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

Answer 1

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

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

此过程必须位于保存“来自网络”函数结果的同一工作簿中。

第一次在更新“From web”功能之前运行这个程序，以便将实际结果添加到“PhoneLog”中。此后，在 “From web” 函数之后立即运行此过程。

如果在工作簿中找不到 “PhoneLog” 工作表，此过程将创建它。然后它将 “WebFrom” 工作表中的所有新记录添加到 “PhoneLog”（根据需要更改）。

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).

Answer 2

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

我可能会使用这种方法：

1. 在每个新的刷新查询之前，我会将现有数据复制到某个“所有数据”表中。
2. 刷新来自 Web 查询
3. 将第 2 步中的新数据复制到“所有数据”表中，并附加到底部。
4. 删除重复项。

替代方案：HTTP 请求或 Internet Explorer 导航

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

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

然后您可以导入所有数据并在之后删除重复项，或者您可以在导入前扫描，以查看记录是否不存在，然后再导入。