0

我正在运行几个宏来计算 B 列中文本的单词、字符、段落和其他内容。但是 B 列中的一些文本是超链接。

输出表: 输出表

现在,我有打开超链接并将网站数据爬回到不同工作表上的 Excel 的代码(如下)(图 02)。

Display_Stylometric_Scores_URL 运行后

在数据表中,它计算文本中有多少单词、字符、段落和其他内容,然后将所有内容相加(首先按列;然后按单词、字符、段落等)并将值传输到输出床单。

已添加总计,想要这些总计,请转到相应列中的输出表

但是,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

谢谢!

4

1 回答 1

0

遵循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...

还要确保您没有textRowloop.

于 2013-03-04T03:15:17.683 回答