在 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 中。
我想知道是否有一种方法可以在不覆盖旧数据的情况下持续导入新数据。在我看来,没有办法通过调整导入设置来做到这一点,所以我正在考虑不同的解决方法。不过,我还没有想出任何可以做到这一点的远程方法。
复制旧数据,刷新,复制新数据,删除重复项
我可能会使用这种方法:
- 在每个新的刷新查询之前,我会将现有数据复制到一些 "All data" sheet.
- 刷新来自 Web 查询
- 将步骤 2 中的新数据复制到 "All data" sheet,附加在底部。
- 删除重复项。
备选方案: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),
我正在将在线 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 中。
我想知道是否有一种方法可以在不覆盖旧数据的情况下持续导入新数据。在我看来,没有办法通过调整导入设置来做到这一点,所以我正在考虑不同的解决方法。不过,我还没有想出任何可以做到这一点的远程方法。
复制旧数据,刷新,复制新数据,删除重复项
我可能会使用这种方法:
- 在每个新的刷新查询之前,我会将现有数据复制到一些 "All data" sheet.
- 刷新来自 Web 查询
- 将步骤 2 中的新数据复制到 "All data" sheet,附加在底部。
- 删除重复项。
备选方案: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),