我正在运行几个宏来计算 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
谢谢!