获取外部数据时最后一个零被截断
Last Zeros Truncated When Getting External Data
在 Excel 2019 年从网络导入数据时选择 Data>Get Data>From Other Sources>From Web，数字的最后（尾随）零被截断，导致以下 'Import' 列：
EU
Import | Desired
968,8 | 968800
891,01 | 891010
413,47 | 413470
410,3 | 410300
43,25 | 43250
17,8 | 17800
15,05 | 15050
3,61 | 3610
6,05 | 6050
4,9 | 4900
US
Import | Desired
968.8 | 968800
891.01 | 891010
413.47 | 413470
410.3 | 410300
43.25 | 43250
17.8 | 17800
15.05 | 15050
3.61 | 3610
6.05 | 6050
4.9 | 4900
我想将文本数据（逗号、句点保留为千位分隔符）转换为所需列中的数字。
我过度使用了以下工作 VBA 函数：
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function UnTruncate(SourceVariant As Variant, _
Optional TruncateString As String = "0", _
Optional SplitSeparator As String = ",", _
Optional NumberOfDigits As Long = 3) As Long
Dim vnt As Variant ' String Array (0-based, 1-dimensional)
Dim strSource As String ' Source String
Dim strResult As String ' Resulting String
Dim strUB As String ' Upper Bound String
Dim i As Long ' String Array Elements Counter
' Convert SourceVariant to a string (Source String (strSource)).
strSource = CStr(SourceVariant)
' Check if Source String (strSource) is "" (UnTruncate = 0, by default).
If strSource = "" Then Exit Function
' Split Source String (strSource) by SplitSeparator.
vnt = Split(strSource, SplitSeparator)
' Assign the value of the last element in String Array (vnt)
' to Upper Bound String (strUB).
strUB = vnt(UBound(vnt))
' Check if there is only one element in String Array (vnt). If so,
' write its value (strUB) to Resulting String (strResult) and go to
' ProcedureSuccess.
If UBound(vnt) = 0 Then strResult = strUB: GoTo ProcedureSuccess
' Check if the length of Upper Bound String (strUB) is greater than
' NumberOfDigits. (UnTruncate = 0, by default)
If Len(strUB) > NumberOfDigits Then Exit Function
' Add the needed number of TruncateStrings to Upper Bound String.
strUB = strUB & String(NumberOfDigits - Len(strUB), TruncateString)
' Loop through the elements of String Array (vnt), from beginning
' to the element before the last, and concatenate them one after another
' to the Resulting String (strResult).
For i = 0 To UBound(vnt) - 1: strResult = strResult & vnt(i): Next
' Add Upper Bound String (strUB) to the end of Resulting String (strResult).
strResult = strResult & strUB
ProcedureSuccess:
' Convert Resulting String (strResult) to the resulting value of UnTruncate.
UnTruncate = Val(strResult)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
但我觉得我遗漏了一些要点。
我正在寻找其他解决方案：我的函数的改进、Excel 公式、Power Query 解决方案……可能当导入列中的数据可能是数字或文本时。
您似乎使用的是 Legacy Wizard 而不是 Power Query。
如果您使用 Power Query，在 selecting Table 之后，select Transform.
然后，如果数字列已作为文本导入，并且显示逗号的数字分隔符，请不要删除逗号。相反：
- 右键单击列 Header
- 从 Right-Click 下拉菜单中：
- Select
Change Type --> Using Locale
- 数据类型：整数
这应该能解决问题。
编辑：
关于使用 Power Query 从 Web table 保留 hyperlinks，它不像旧版向导那样简单，但这里有一个方法似乎适用于您的来源。
它需要三个查询和一个函数。下载后您需要编辑 table 以格式化数字，可能还有 hyperlinks.
- 查询“Table 0” 下载网页 table 没有 links
- 查询“getLinks”下载与视频相关联的 links
- 查询“Merge1”合并上面的两个查询
- 查询fxExcelTrim" 复制Excel的trim以便能够匹配第一个中的视频名称两个查询，通过消除视频标题中单词之间的多余空格。
ExcelTrim
将下面的代码输入空白查询的高级编辑器
let ExcelTrim = (TextToTrim) =>
let
ReplacedText = Text.Replace(TextToTrim, " ", " "),
Result = if not(Text.Contains(ReplacedText, " "))
then ReplacedText
else @ExcelTrim(ReplacedText)
in
Text.Trim(Result)
in
ExcelTrim
Table 0
注意我使用了 Changed Type with Locale 功能，它应该可以消除掉零的问题。
let
Source = Web.Page(Web.Contents("https://kworb.net/youtube/")),
Data = Source{0}[Data],
#"Changed Type with Locale" = Table.TransformColumnTypes(Data, {{"Views", Int64.Type}, {"Likes", Int64.Type}}, "en-US"),
#"Added Custom" = Table.AddColumn(#"Changed Type with Locale", "trimmedVideo", each ExcelTrim([Video]))
in
#"Added Custom"
获取链接
let
Source = Table.FromColumns({Lines.FromBinary(Web.Contents("https://kworb.net/youtube/"))}),
#"Filtered Rows" = Table.SelectRows(Source, each Text.Contains([Column1], "href")),
#"Filtered Rows1" = Table.SelectRows(#"Filtered Rows", each Text.Contains([Column1], "<div><a href=")),
#"Added Custom" = Table.AddColumn(#"Filtered Rows1", "Link", each Text.BetweenDelimiters([Column1],"<a href=""","</a>")),
#"Split Column by Delimiter" = Table.SplitColumn(#"Added Custom", "Link", Splitter.SplitTextByEachDelimiter({""">"}, QuoteStyle.None, false), {"Link.1", "Link.2"}),
#"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Link.1", type text}, {"Link.2", type text}}),
#"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"Column1"}),
#"Added Custom1" = Table.AddColumn(#"Removed Columns", "trimmedVideo", each ExcelTrim([Link.2])),
#"Added Custom2" = Table.AddColumn(#"Added Custom1", "normLinks", each if not Text.StartsWith([Link.1],"http") then
"https://kworb.net/youtube/" & [Link.1] else
[Link.1])
in
#"Added Custom2"
合并1
Returns link 与视频
分开列
let
Source = Table.NestedJoin(#"Table 0", {"trimmedVideo"}, getLinks, {"trimmedVideo"}, "getLinks", JoinKind.LeftOuter),
#"Added Custom" = Table.AddColumn(Source, "Links", each Table.Column([getLinks],"normLinks")),
#"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Links", each Text.Combine(List.Transform(_, Text.From)), type text}),
#"Removed Columns" = Table.RemoveColumns(#"Extracted Values",{"trimmedVideo", "getLinks"})
in
#"Removed Columns"
或者您可以使用：
合并 1 (2)
Returns table 的 HYPERLINK 公式，它提供了一个带有友好名称的可点击 link。
let
Source = Table.NestedJoin(#"Table 0", {"trimmedVideo"}, getLinks, {"trimmedVideo"}, "getLinks", JoinKind.LeftOuter),
#"Added Custom" = Table.AddColumn(Source, "Links", each Table.Column([getLinks],"normLinks")),
#"Replaced Value" = Table.ReplaceValue(#"Added Custom","""","""""",Replacer.ReplaceText,{"Video"}),
#"Extracted Values" = Table.TransformColumns(#"Replaced Value", {"Links", each Text.Combine(List.Transform(_, Text.From)), type text}),
#"Removed Columns" = Table.RemoveColumns(#"Extracted Values",{"trimmedVideo", "getLinks"}),
#"Added Custom1" = Table.AddColumn(#"Removed Columns", "Linked Videos", each "=HYPERLINK(""" & [Links] & """," & """" &[Video] & """)"),
#"Changed Type" = Table.TransformColumnTypes(#"Added Custom1",{{"Linked Videos", type text}}),
#"Removed Columns1" = Table.RemoveColumns(#"Changed Type",{"Video", "Links"}),
#"Reordered Columns" = Table.ReorderColumns(#"Removed Columns1",{"", "2", "Linked Videos", "Views", "Likes"})
in
#"Reordered Columns"
如果使用Merge1(2)得到hyperlinks，保存后需要select Linked Video 列，并使用 = 执行 Find/Replace 或 = 以将公式从文本字符串转换为公式。如果刷新查询，则需要重复此过程。
您可能还想格式化 Views 和 Likes 列以显示千位分隔符。
这是一个使用 `Merge1 (2) 与 hyperlinks 和我的千位分隔符的例子。
这是一个向您提到的 url 发布 xhr 并使用剪贴板将 table 复制到 sheet 的示例。数字显示在页面上。您确实需要对 html 有一定的了解，或者至少知道如何右键单击检查元素（打开元素选项卡）；右键单击开发工具元素选项卡中的复制选择器 - 然后您可以将该选择器粘贴到 html.querySelector("selector goes here").outerHTML 中；假设选择 table.
Public Sub GetVideoInfo()
Dim xhr As Object, clipboard As Object, html As MSHTML.HTMLDocument 'required VBE > Tools > References > Microsoft HTML Object Library
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set xhr = CreateObject("MSXML2.XMLHTTP")
Set html = New MSHTML.HTMLDocument
With xhr
.Open "GET", "https://kworb.net/youtube/", False
.send
html.body.innerHTML = .responseText
End With
clipboard.SetText html.querySelector("#youtuberealtime").outerHTML
clipboard.PutInClipboard
ActiveSheet.Cells(1, 1).PasteSpecial
End Sub
在 Excel 2019 年从网络导入数据时选择 Data>Get Data>From Other Sources>From Web，数字的最后（尾随）零被截断，导致以下 'Import' 列：
EU
Import | Desired
968,8 | 968800
891,01 | 891010
413,47 | 413470
410,3 | 410300
43,25 | 43250
17,8 | 17800
15,05 | 15050
3,61 | 3610
6,05 | 6050
4,9 | 4900
US
Import | Desired
968.8 | 968800
891.01 | 891010
413.47 | 413470
410.3 | 410300
43.25 | 43250
17.8 | 17800
15.05 | 15050
3.61 | 3610
6.05 | 6050
4.9 | 4900
我想将文本数据（逗号、句点保留为千位分隔符）转换为所需列中的数字。
我过度使用了以下工作 VBA 函数：
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function UnTruncate(SourceVariant As Variant, _
Optional TruncateString As String = "0", _
Optional SplitSeparator As String = ",", _
Optional NumberOfDigits As Long = 3) As Long
Dim vnt As Variant ' String Array (0-based, 1-dimensional)
Dim strSource As String ' Source String
Dim strResult As String ' Resulting String
Dim strUB As String ' Upper Bound String
Dim i As Long ' String Array Elements Counter
' Convert SourceVariant to a string (Source String (strSource)).
strSource = CStr(SourceVariant)
' Check if Source String (strSource) is "" (UnTruncate = 0, by default).
If strSource = "" Then Exit Function
' Split Source String (strSource) by SplitSeparator.
vnt = Split(strSource, SplitSeparator)
' Assign the value of the last element in String Array (vnt)
' to Upper Bound String (strUB).
strUB = vnt(UBound(vnt))
' Check if there is only one element in String Array (vnt). If so,
' write its value (strUB) to Resulting String (strResult) and go to
' ProcedureSuccess.
If UBound(vnt) = 0 Then strResult = strUB: GoTo ProcedureSuccess
' Check if the length of Upper Bound String (strUB) is greater than
' NumberOfDigits. (UnTruncate = 0, by default)
If Len(strUB) > NumberOfDigits Then Exit Function
' Add the needed number of TruncateStrings to Upper Bound String.
strUB = strUB & String(NumberOfDigits - Len(strUB), TruncateString)
' Loop through the elements of String Array (vnt), from beginning
' to the element before the last, and concatenate them one after another
' to the Resulting String (strResult).
For i = 0 To UBound(vnt) - 1: strResult = strResult & vnt(i): Next
' Add Upper Bound String (strUB) to the end of Resulting String (strResult).
strResult = strResult & strUB
ProcedureSuccess:
' Convert Resulting String (strResult) to the resulting value of UnTruncate.
UnTruncate = Val(strResult)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
但我觉得我遗漏了一些要点。
我正在寻找其他解决方案：我的函数的改进、Excel 公式、Power Query 解决方案……可能当导入列中的数据可能是数字或文本时。
您似乎使用的是 Legacy Wizard 而不是 Power Query。
如果您使用 Power Query，在 selecting Table 之后，select Transform.
然后，如果数字列已作为文本导入，并且显示逗号的数字分隔符，请不要删除逗号。相反：
- 右键单击列 Header
- 从 Right-Click 下拉菜单中：
- Select
Change Type --> Using Locale - 数据类型：整数
- Select
这应该能解决问题。
编辑：
关于使用 Power Query 从 Web table 保留 hyperlinks，它不像旧版向导那样简单，但这里有一个方法似乎适用于您的来源。
它需要三个查询和一个函数。下载后您需要编辑 table 以格式化数字，可能还有 hyperlinks.
- 查询“Table 0” 下载网页 table 没有 links
- 查询“getLinks”下载与视频相关联的 links
- 查询“Merge1”合并上面的两个查询
- 查询fxExcelTrim" 复制Excel的trim以便能够匹配第一个中的视频名称两个查询，通过消除视频标题中单词之间的多余空格。
ExcelTrim
将下面的代码输入空白查询的高级编辑器
let ExcelTrim = (TextToTrim) =>
let
ReplacedText = Text.Replace(TextToTrim, " ", " "),
Result = if not(Text.Contains(ReplacedText, " "))
then ReplacedText
else @ExcelTrim(ReplacedText)
in
Text.Trim(Result)
in
ExcelTrim
Table 0
注意我使用了 Changed Type with Locale 功能，它应该可以消除掉零的问题。
let
Source = Web.Page(Web.Contents("https://kworb.net/youtube/")),
Data = Source{0}[Data],
#"Changed Type with Locale" = Table.TransformColumnTypes(Data, {{"Views", Int64.Type}, {"Likes", Int64.Type}}, "en-US"),
#"Added Custom" = Table.AddColumn(#"Changed Type with Locale", "trimmedVideo", each ExcelTrim([Video]))
in
#"Added Custom"
获取链接
let
Source = Table.FromColumns({Lines.FromBinary(Web.Contents("https://kworb.net/youtube/"))}),
#"Filtered Rows" = Table.SelectRows(Source, each Text.Contains([Column1], "href")),
#"Filtered Rows1" = Table.SelectRows(#"Filtered Rows", each Text.Contains([Column1], "<div><a href=")),
#"Added Custom" = Table.AddColumn(#"Filtered Rows1", "Link", each Text.BetweenDelimiters([Column1],"<a href=""","</a>")),
#"Split Column by Delimiter" = Table.SplitColumn(#"Added Custom", "Link", Splitter.SplitTextByEachDelimiter({""">"}, QuoteStyle.None, false), {"Link.1", "Link.2"}),
#"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Link.1", type text}, {"Link.2", type text}}),
#"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"Column1"}),
#"Added Custom1" = Table.AddColumn(#"Removed Columns", "trimmedVideo", each ExcelTrim([Link.2])),
#"Added Custom2" = Table.AddColumn(#"Added Custom1", "normLinks", each if not Text.StartsWith([Link.1],"http") then
"https://kworb.net/youtube/" & [Link.1] else
[Link.1])
in
#"Added Custom2"
合并1
Returns link 与视频
分开列let
Source = Table.NestedJoin(#"Table 0", {"trimmedVideo"}, getLinks, {"trimmedVideo"}, "getLinks", JoinKind.LeftOuter),
#"Added Custom" = Table.AddColumn(Source, "Links", each Table.Column([getLinks],"normLinks")),
#"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Links", each Text.Combine(List.Transform(_, Text.From)), type text}),
#"Removed Columns" = Table.RemoveColumns(#"Extracted Values",{"trimmedVideo", "getLinks"})
in
#"Removed Columns"
或者您可以使用：
合并 1 (2)
Returns table 的 HYPERLINK 公式，它提供了一个带有友好名称的可点击 link。
let
Source = Table.NestedJoin(#"Table 0", {"trimmedVideo"}, getLinks, {"trimmedVideo"}, "getLinks", JoinKind.LeftOuter),
#"Added Custom" = Table.AddColumn(Source, "Links", each Table.Column([getLinks],"normLinks")),
#"Replaced Value" = Table.ReplaceValue(#"Added Custom","""","""""",Replacer.ReplaceText,{"Video"}),
#"Extracted Values" = Table.TransformColumns(#"Replaced Value", {"Links", each Text.Combine(List.Transform(_, Text.From)), type text}),
#"Removed Columns" = Table.RemoveColumns(#"Extracted Values",{"trimmedVideo", "getLinks"}),
#"Added Custom1" = Table.AddColumn(#"Removed Columns", "Linked Videos", each "=HYPERLINK(""" & [Links] & """," & """" &[Video] & """)"),
#"Changed Type" = Table.TransformColumnTypes(#"Added Custom1",{{"Linked Videos", type text}}),
#"Removed Columns1" = Table.RemoveColumns(#"Changed Type",{"Video", "Links"}),
#"Reordered Columns" = Table.ReorderColumns(#"Removed Columns1",{"", "2", "Linked Videos", "Views", "Likes"})
in
#"Reordered Columns"
如果使用Merge1(2)得到hyperlinks，保存后需要select Linked Video 列，并使用 = 执行 Find/Replace 或 = 以将公式从文本字符串转换为公式。如果刷新查询，则需要重复此过程。
您可能还想格式化 Views 和 Likes 列以显示千位分隔符。
这是一个使用 `Merge1 (2) 与 hyperlinks 和我的千位分隔符的例子。
这是一个向您提到的 url 发布 xhr 并使用剪贴板将 table 复制到 sheet 的示例。数字显示在页面上。您确实需要对 html 有一定的了解，或者至少知道如何右键单击检查元素（打开元素选项卡）；右键单击开发工具元素选项卡中的复制选择器 - 然后您可以将该选择器粘贴到 html.querySelector("selector goes here").outerHTML 中；假设选择 table.
Public Sub GetVideoInfo()
Dim xhr As Object, clipboard As Object, html As MSHTML.HTMLDocument 'required VBE > Tools > References > Microsoft HTML Object Library
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set xhr = CreateObject("MSXML2.XMLHTTP")
Set html = New MSHTML.HTMLDocument
With xhr
.Open "GET", "https://kworb.net/youtube/", False
.send
html.body.innerHTML = .responseText
End With
clipboard.SetText html.querySelector("#youtuberealtime").outerHTML
clipboard.PutInClipboard
ActiveSheet.Cells(1, 1).PasteSpecial
End Sub