excel 刮网站混乱，以改善代码

pxyaymoc 于 2023-04-22 发布在其他

关注(0)|答案(2)|浏览(125)

这是唯一可行的方法，但我觉得这很丑陋。
有没有一种方法可以改进这一点，比如创建一个函数式FOR？或者这是处理这些字符串的最佳方法？

i.Navigate "https://inara.cz/elite/cmdr/42411/"
Do While i.Busy Or i.ReadyState <> READYSTATE_COMPLETE
Loop

Dim rank_combat, rank_trade, rank_explorer, rank_merc, rank_exo, rank_cqc As Variant

lin_B = Range("B65000").End(xlUp).Row + 3

rank_combat = idoc.getElementsByClassName("rankvalue").Item(0).innerText
rank_trade = idoc.getElementsByClassName("rankvalue").Item(1).innerText
rank_explorer = idoc.getElementsByClassName("rankvalue").Item(2).innerText
rank_merc = idoc.getElementsByClassName("rankvalue").Item(3).innerText
rank_exo = idoc.getElementsByClassName("rankvalue").Item(4).innerText
rank_cqc = idoc.getElementsByClassName("rankvalue").Item(5).innerText

clip.SetText "" & rank_combat & ""
clip.PutInClipboard
    Range("B" & lin_B).Value = "Combat"
    Range("C" & lin_B).Select
    ActiveSheet.PasteSpecial Format:="Texto unicode", link:=False, _
    DisplayAsIcon:=False, NoHTMLFormatting:=True

clip.SetText "" & rank_trade & ""
clip.PutInClipboard
    Range("B" & lin_B + 1).Value = "Trade"
    Range("C" & lin_B + 1).Select
    ActiveSheet.PasteSpecial Format:="Texto unicode", link:=False, _
    DisplayAsIcon:=False, NoHTMLFormatting:=True
    
clip.SetText "" & rank_explorer & ""
clip.PutInClipboard
    Range("B" & lin_B + 2).Value = "Explorer"
    Range("C" & lin_B + 2).Select
    ActiveSheet.PasteSpecial Format:="Texto unicode", link:=False, _
    DisplayAsIcon:=False, NoHTMLFormatting:=True
    
clip.SetText "" & rank_merc & ""
clip.PutInClipboard
    Range("B" & lin_B + 3).Value = "Mercenary"
    Range("C" & lin_B + 3).Select
    ActiveSheet.PasteSpecial Format:="Texto unicode", link:=False, _
    DisplayAsIcon:=False, NoHTMLFormatting:=True
    
clip.SetText "" & rank_exo & ""
clip.PutInClipboard
    Range("B" & lin_B + 4).Value = "Exobiology"
    Range("C" & lin_B + 4).Select
    ActiveSheet.PasteSpecial Format:="Texto unicode", link:=False, _
    DisplayAsIcon:=False, NoHTMLFormatting:=True

代码进入网站inara cz获取一些类并复制到剪贴板并粘贴在excel中的一些行。

excel

来源：https://stackoverflow.com/questions/76000677/scraping-website-confusion-to-improve-code

2条答案

按热度按时间

iszxjhcz1#

这里有一个方法可以清理它：

Sub Tester()
    '...
    Dim arr As Variant, c As Range, n As Long, els As Object, ws As Worksheet
    
    '...
    '...
    i.Navigate "https://inara.cz/elite/cmdr/42411/"
    
    Do While i.Busy Or i.ReadyState <> READYSTATE_COMPLETE
    Loop
    
    Set ws = ActiveSheet                             'or some specific sheet
    Set c = ws.Range("B65000").End(xlUp).Offset(3)   'starting point for data
    arr = Array("Combat", "Trade", "Explorer", "Mercenary", "Exobiology")
    
    Set els = i.document.getElementsByClassName("rankvalue") 'get the elements
    
    For n = LBound(arr) To UBound(arr)                  'loop the array of labels
        c.value = arr(n)                                'label
        c.Offset(0, 1).value = els.Item(n).innerText    'value
        Set c = c.Offset(1)                             'next row down
    Next i
    
End Sub

赞(0）回复(0）举报 2023-04-22

nwlqm0z12#

tnx @Tim威廉姆斯我还根据您的代码成功创建了另一个漂亮的形状，非常感谢

Dim rank As Variant
Dim i As Integer
ranks = Array("Combat", "Explorer", "Trade", "Mercenary", "Exobiology", "CQC")

lin_B = Range("B65000").End(xlUp).Row + 3

i = 0 ' Initialize variable.
While i < 6 ' Test value of Counter.
            rank = IE.Document.getElementsByClassName("rankvalue").Item(i).innerText
            Range("B" & lin_B + i).Value = ranks(i)
            Range("C" & lin_B + i).Value = rank
            i = i + 1 ' Increment Counter.
Wend ' End While loop when Counter > 6.

赞(0）回复(0）举报 2023-04-22

我来回答

excel 刮网站混乱，以改善代码

2条答案

相关问题

热门标签

最新问答