如何将 HTML 源代码复制到工作表

时间:2021-01-28 16:54:40

标签: html excel vba

所以我有这个代码,它将整个 HTML 源代码剥离到列中的下一个单元格。问题是我用来提取 HTML 源代码的网页有一些波兰语字母,如“ą”、“ś”等。 有没有办法用这些波兰字母粘贴代码?现在我得到了一些带有问号等的疯狂方块。有什么提示吗?

ps。感谢@pizzettix https://stackoverflow.com/users/6254609/pizzettix

,我得到了这个代码
Sub audycje()
    
    Dim strona As Object
    Dim adres As String
    Dim wb As Workbook
    Dim a As Object
    Dim str_var As Variant
    
    Set wb = ThisWorkbook
    adres = InputBox("Podaj adres strony")
    If adres = "" Then
       MsgBox ("Nie podano strony do zaladowania")
    Exit Sub
    End If
    
    Set strona = CreateObject("htmlfile")   'Create HTMLFile Object
    With CreateObject("msxml2.xmlhttp")  'Get the WebPage Content
       .Open "GET", adres, False
       .send
       strona.Body.Innerhtml = .responseText
    End With
    
    'Split_with_delimiter_newline
    split_var = Split(strona.Body.Innerhtml, Chr(10))
    
    Application.ScreenUpdating = False
    
    For i = 0 To UBound(split_var, 1)
       Cells(2 + i, 2).Value2 = split_var(i)
    Next i
    
    Application.ScreenUpdating = True
    
    End Sub

3 个答案:

答案 0 :(得分:0)

方案一:可以使用Excel中的“获取外部数据”功能导入html页面。

将数据放入单元格后,可以使用以下函数将奇数字符或重音字符替换为常规字符。

下面是我用来用普通字符替换重音字符的函数:

Function StripAccent(thestring As String)
' Replaces accented characters with regular characters
  Dim A As String * 1
  Dim B As String * 1
  Dim i As Integer
  Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåáçèéêëéìíîïðñòóôõöøùúûüýÿ"
  Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaaceeeeeiiiidnoooooouuuuyy"
  For i = 1 To Len(AccChars)
    A = Mid(AccChars, i, 1)
    B = Mid(RegChars, i, 1)
    thestring = Replace(thestring, A, B)
    thestring = Application.WorksheetFunction.Trim(thestring)
  Next
  StripAccent = thestring
End Function 

选项 2: 另一种选择是将文档作为“Unicode 文本”导入。这应该保留波兰语字符。

为了测试,我从网页上复制了一个波兰语段落,然后使用选择性粘贴 >> Unicode 文本将其粘贴到 Excel 电子表格单元格中,并保留了波兰语字符。

答案 1 :(得分:0)

对于编码问题,请在开头添加(Office 2013 及更高版本中可用的功能):

Mystring = WorksheetFunction.EncodeURL(Mystring)

请参阅我在 Extract content of div from Google Translate with VBA 上的原始帖子

如果您的 Office 版本是 2013 之前的版本,或者您需要分发给可能有旧版本的用户,请使用: How can I URL encode a string in Excel VBA?

像这样改变你的代码:

Dim Mystring as string
For i = 0 To UBound(split_var, 1)
   Mystring= split_var(i)
   Mystring = WorksheetFunction.EncodeURL(Mystring)
   Cells(2 + i, 2).Value2 = Mystring
Next i

答案 2 :(得分:0)

经过一个月的搜索,我终于找到了! 下面的代码可以解决问题:)

由于版主无故删除了我的回答,再次发帖...

下面的代码完成了我正在寻找的工作

POST myindex/_search
{
  "size": 0,
  "query": {
    "multi_match": {
      "query": "apple",
      "type": "phrase"
    }
  },
  "aggs": {
    "fields_breakdown": {
      "scripted_metric": {
        "params": {
          "phrase": "apple"
        }, 
        "init_script": "state.key_map = [:];",
        "map_script": """
          for (def pair : params._source.entrySet()) {
            def val = pair.getValue();
            
            if (!(val instanceof String) || !val.toLowerCase().contains(params.phrase.toLowerCase())) {
              continue;
            }
            
            def key = pair.getKey();
            
            if (!state.key_map.containsKey(key)) {
              state.key_map[key] = [val];
            } else if (!state.key_map[key].contains(val)) {
              state.key_map[key].add(val);
            }
          }
        """,
        "combine_script": "return state",
        "reduce_script": "return states"
      }
    }
  }
}