由于多个超链接，在读取超链接后未从另一个工作表中获取总数

Question

我正在运行几个宏来计算B列中文本的单词，字符，段落等。但是B列中的某些文本是超链接。

输出表：

现在，我有一个代码（下面）打开超链接并将网站数据抓取到另一张纸上的Excel（图片02）。

在数据表中，它计算文本的单词，字符，段落和其他数量，然后将所有内容相加（首先，按列;然后按字，字符，段落等）并传输值到输出表。

但是，Display_Stylometric_Scores_Text中的For循环读取输出表中B列中的超链接，它将读取并处理所有超链接，但只给出了最后一个超链接的正确传输值。

并非所有结果都正确传输：

我正在使用一个名为textRow的变量来跟踪正在阅读的文本行。我已经尝试将textRow = textRow + 1放入For循环中，希望它将读取第一个超链接并将总计传回到输出表，但是当我这样做时，它不能正确处理任何超链接。在此示例中，第一个超链接位于第24行，因此textRow = 24.

我想我的问题是：我怎样仍然可以使用For循环逐行读取超链接（更新textRow），并且只有在从上一个超链接输出正确的总数后才会转到下一行或下一个超链接？

代码包括：

Sub Display_Stylometric_Scores_Text()
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 ActiveDocument As Object
Dim RS As Object
Dim link As Hyperlink
Dim path As String

textRow = 24

path = Dir("C:\Users\Jeannette\Desktop\*.txt")

Set ActiveDocument = CreateObject("Word.Document")

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

    textValue = Worksheets("Sample_Output_2").Cells(textRow, 2).Value
    ActiveDocument.Content = textValue

    Set RS = ActiveDocument.Content.ReadabilityStatistics

   For Each link In Worksheets("Sample_Output_2").Cells(textRow, 2).Hyperlinks
        activeWorkbook.Worksheets.Add
        With ActiveSheet.QueryTables.Add(Connection:="URL;" & textValue, Destination:=Range("$A$1"))
            .Name = "Text From URL"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        ActiveSheet.Activate

        Call Display_Stylometric_Scores_URL

        Worksheets("Sample_Output_2").Cells(textRow, 4).Value = ActiveSheet.Cells(finalRow, 4).Value
        Worksheets("Sample_Output_2").Cells(textRow, 5).Value = ActiveSheet.Cells(finalRow, 5).Value
        Worksheets("Sample_Output_2").Cells(textRow, 6).Value = ActiveSheet.Cells(finalRow, 6).Value
        Worksheets("Sample_Output_2").Cells(textRow, 7).Value = ActiveSheet.Cells(finalRow, 7).Value
        Worksheets("Sample_Output_2").Cells(textRow, 8).Value = ActiveSheet.Cells(finalRow, 8).Value
        Worksheets("Sample_Output_2").Cells(textRow, 9).Value = ActiveSheet.Cells(finalRow, 9).Value
        Worksheets("Sample_Output_2").Cells(textRow, 10).Value = ActiveSheet.Cells(finalRow, 10).Value
        Worksheets("Sample_Output_2").Cells(textRow, 11).Value = ActiveSheet.Cells(finalRow, 11).Value
        Worksheets("Sample_Output_2").Cells(textRow, 12).Value = ActiveSheet.Cells(finalRow, 12).Value
        Worksheets("Sample_Output_2").Cells(textRow, 13).Value = ActiveSheet.Cells(finalRow, 13).Value
        Worksheets("Sample_Output_2").Cells(textRow, 14).Value = ActiveSheet.Cells(finalRow, 14).Value
        Worksheets("Sample_Output_2").Cells(textRow, 15).Value = ActiveSheet.Cells(finalRow, 15).Value

        textRow = textRow + 1

    Next link

谢谢！

Answer 1

遵循Do和For Each循环中的逻辑：

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

   For Each link In Worksheets("Sample_Output_2").Cells(textRow, 2).Hyperlinks
        textRow = textRow + 1
    Next link

loop 'presumably somewhere after all this...

您正在尝试执行以下操作（使用伪代码和单词）：

1. 检查单元格是否为空
2. 如果其中有链接，请调用Display_Stylometric_Scores_URL以报告信息
3. 移至下一行并再次转到＃1

所以形成这样的循环：

textRow = 24
Do While Worksheets("Sample_Output_2").Cells(textRow, 1) <> ""

   'check if there is a link, if so, do your operation on it
     For Each link In Worksheets("Sample_Output_2").Cells(textRow, 2).Hyperlinks
        call Display_Stylometric_Scores_URL to report the information
     Next link

    'now we've checked the links in that cell in that row, we can move to the next row
    textRow = textRow + 1
loop 'presumably somewhere after all this...

另外，请确保在textRow之前切断的任何代码中都没有递增loop。