1

是否可以从 excel 中的超链接读取网页并直接计算网页的可读性分数、与号和感叹号，而无需通过更改此 VBA 代码将数据查询回 excel？也有可能来自文件路径？这一切都在一个电子表格中。

Option Compare Text

Sub Display_Stylometric_Scores()
    Dim Words As String
    Dim Characters As String
    Dim Paragraphs As String
    Dim Sentences As String
    Dim Sentences_per_paragraph As String
    Dim Words_per_sentence As String
    Dim Characters_per_word As String
    Dim Ratio_of_passive_sentences As String
    Dim Flesch_Reading_Ease_score As String
    Dim Flesch_Kincaid_Grade_Level_score As String
    Dim Coleman_Liau_Readability_Score As String
    Dim Ampersands As Long
    Dim Exclamations As Long
    Dim row As Integer
    Dim column As Integer
    Dim ActiveDocument As Object
    Dim RS As Object
    Dim txt As String

    row = 3

    Set ActiveDocument = CreateObject("Word.Document")

    Do While Worksheets("Sample_Output_2").Cells(row, 1) <> ""

        txt = Worksheets("Sample_Output_2").Cells(row, 2).Value
        ActiveDocument.Content = txt

        Set RS = ActiveDocument.Content.ReadabilityStatistics

        Words = RS(1).Value
        Characters = RS(2).Value
        Paragraphs = RS(3).Value
        Sentences = RS(4).Value
        Sentences_per_paragraph = RS(5).Value
        Words_per_sentence = RS(6).Value
        Characters_per_word = RS(7).Value
        Ratio_of_passive_sentences = RS(8).Value
        Flesch_Reading_Ease_score = RS(9).Value
        Flesch_Kincaid_Grade_Level_score = RS(10).Value
        Ampersands = CountChar(txt, "&")
        Exclamations = CountChar(txt, "!")

        Worksheets("Sample_Output_2").Cells(row, 4).Resize(1, 12).Value = 
            Array(Words, Characters, Paragraphs, Sentences, Sentences_per_paragraph, _               
                Words_per_sentence, Characters_per_word, Ratio_of_passive_sentences, _
                Flesch_Reading_Ease_score, Flesch_Kincaid_Grade_Level_score, _
                Ampersands, Exclamations)

        row = row + 1
    Loop

End Sub

Function CountChar(txt As String, char As String) As Long
    CountChar = Len(txt) - Len(Replace(txt, char, ""))
End Function
4

1 回答 1

1

是的，您可以使用 MXSML 发出 http 请求。这是一个示例和对现有代码的一些重构

Sub Main()

    Dim vaWrite As Variant
    Dim hDoc As MSHTML.HTMLDocument
    Dim xHttp As MSXML2.XMLHTTP

    'Set a reference to MSXML2
    'Open a webpage using GET
    Set xHttp = New MSXML2.XMLHTTP
    xHttp.Open "GET", "http://stackoverflow.com/questions/15103048/count-data-on-webpage-from-url-in-excel-vba"
    xHttp.send

    'Wait for the web page to finish loading
    Do Until xHttp.readyState = 4
        DoEvents
    Loop

    'If the web page rendered properly
    If xHttp.Status = 200 Then
        'Create a new HTMLdocument
        Set hDoc = New MSHTML.HTMLDocument
        'Put the GET response into the doc's body
        hDoc.body.innerHTML = xHttp.responseText

        'Get an array back containing the readability scores
        vaWrite = Display_Stylometric_Scores(hDoc.body.innerText)

        'Write that array to a worksheet
        Sheet1.Range("A2").Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite
    End If

End Sub

Function Display_Stylometric_Scores(ByRef sText As String) As Variant

    Dim aReadStats(1 To 1, 1 To 12) As Double
    Dim wdDoc As Object
    Dim wdRs As Object
    Dim i As Long
    Dim vaSpecial As Variant

    Const lMAXIDX As Long = 10

    vaSpecial = Array("&", "!")

    Set wdDoc = CreateObject("Word.Document")
    wdDoc.Content = sText

    Set wdRs = wdDoc.Content.ReadabilityStatistics

    For i = 1 To lMAXIDX
        aReadStats(1, i) = wdRs(i).Value
    Next i

    For i = LBound(vaSpecial) To UBound(vaSpecial)
        aReadStats(1, lMAXIDX + 1 + i) = CountChar(sText, vaSpecial(i))
    Next i

    Display_Stylometric_Scores = aReadStats

End Function

Function CountChar(ByRef sText As String, ByVal sChar As String) As Long
    CountChar = Len(sText) - Len(Replace(sText, sChar, vbNullString))
End Function
于 2013-02-27T03:25:47.773 回答