excel - 複数のハイパーリンクが原因で、ハイパーリンクが読み取られた後に別のシートから合計を取得できない

Question

列 B のテキストの単語、文字、段落などを数えるマクロをいくつか実行しています。ただし、列 B のテキストの一部はハイパーリンクです。

出力シート:

現在、ハイパーリンクを開き、Web サイトのデータを別のシート (画像 02) の Excel にクロールするコード (以下) があります。

データシートでは、テキストの単語、文字、段落などの数を数え、すべてを合計し (最初に列ごと、次に単語、文字、段落など)、値を出力に転送します。シート。

ただし、出力シートの列 B のハイパーリンクを読み取る Display_Stylometric_Scores_Text の For ループは、すべてのハイパーリンクを読み取って処理しますが、最後のハイパーリンクの正しく転送された値しか提供しませんでした。

すべての結果が正しく転送されるわけではありません:

テキストのどの行を読んでいるかを追跡するために、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

DoandFor 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.