excel - 在 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 调用)。这将反射(reflect)在 Excel 中。

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

Answer 1

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

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

此过程必须位于保存“来自 Web”功能结果的同一工作簿中。

在更新“From web”功能之前第一次运行此程序，以便将实际结果添加到“PhoneLog”。此后，在“来自网络”功能之后立即运行此程序。

如果在工作簿中找不到“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) .