由於多個超鏈接而讀取超鏈接後，未從另一個表中獲取總數

Question

我正在運行很少的宏來計算B列中文本的單詞，字符，段落和其他內容。但是，B列中的一些文本是超鏈接。

輸出片材：

現在，我的代碼（下面），該開口的超級鏈接和在不同的片的網站數據爬行回Excel（圖像02）。

在數據片中，計數多少字，字符，段落和其他的文本的再總結一切融合在一起（第一，通過柱;然後用單詞，字符，段落，和等。）並將值傳輸到輸出工作表。

然而，對於在輸出表中讀取列B中的超鏈接Display_Stylometric_Scores_Text循環，它會讀取並處理所有的超鏈接，但只給了我最後的超鏈接的正確傳輸值。

並非所有的結果才能被正確傳送：

我使用所謂的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... 

另外，還要確保你沒有任何你的loop切斷之前的代碼遞增textRow。