逐行计算Excel文本中的&符号和Exclamations的数量

时间:2013-02-21 19:07:55

标签: vba

我需要有关如何计算Excel中文本中的&符号和感叹号数量的帮助。我只能获得第一行但值不更新。这是我到目前为止的代码。谢谢。

Sub Display_Readability_Scores()
    Dim Stats As Variant
    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 ActiveDocument As Object
    Dim row As Integer
    Dim column As Integer
    Dim amp As String

    row = 2

    Set ActiveDocument = CreateObject("Word.Document")

    Do While Worksheets("Sheet1").Cells(row, 1) <> ""

    ActiveDocument.Content = Worksheets("Sheet1").Cells(row, 2)

    column = 3

    Words = ActiveDocument.Content.ReadabilityStatistics(1).Value
    Characters = ActiveDocument.Content.ReadabilityStatistics(2).Value
    Paragraphs = ActiveDocument.Content.ReadabilityStatistics(3).Value
    Sentences = ActiveDocument.Content.ReadabilityStatistics(4).Value
    Sentences_per_paragraph = ActiveDocument.Content.ReadabilityStatistics(5).Value
    Words_per_sentence = ActiveDocument.Content.ReadabilityStatistics(6).Value
    Characters_per_word = ActiveDocument.Content.ReadabilityStatistics(7).Value
    Ratio_of_passive_sentences = ActiveDocument.Content.ReadabilityStatistics(8).Value
    Flesch_Reading_Ease_score = ActiveDocument.Content.ReadabilityStatistics(9).Value
    Flesch_Kincaid_Grade_Level_score = ActiveDocument.Content.ReadabilityStatistics(10).Value

    amp = Application.WorksheetFunction.CountIf("Worksheets("Sheet1").Cells(row, 2), "&")    

    For Each Stats In Worksheets("Sheet1").Cells(row, 2)

        Worksheets("Sheet1").Cells(row, column) = Words
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Characters
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Paragraphs
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Sentences
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Sentences_per_paragraph
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Words_per_sentence
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Characters_per_word
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Ratio_of_passive_sentences
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Flesch_Reading_Ease_score
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = Flesch_Kincaid_Grade_Level_score
        column = column + 1

        Worksheets("Sheet1").Cells(row, column) = amp

    row = row + 1

    Next Stats

    Loop    
End Sub

1 个答案:

答案 0 :(得分:1)

Sub Display_Readability_Scores()
    Dim Stats As Variant
    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 ActiveDocument As Object
    Dim row As Integer
    Dim column As Integer
    Dim amp As Long, ex As Long

    Dim RS As Object, txt As String

    row = 2

    Set ActiveDocument = CreateObject("Word.Document")

    Do While Worksheets("Sheet1").Cells(row, 1) <> ""

        txt = Worksheets("Sheet1").Cells(row, 2).Value
        ActiveDocument.Content = txt

        Set RS = ActiveDocument.Content.ReadabilityStatistics

        Words = RS(1).Value
        Characters = RS(2).Value
        Paragraphs = RS(3).Value
        Sentences = RS(4).Value
        Sentences_per_paragraph = RS(5).Value
        Words_per_sentence = RS(6).Value
        Characters_per_word = RS(7).Value
        Ratio_of_passive_sentences = RS(8).Value
        Flesch_Reading_Ease_score = RS(9).Value
        Flesch_Kincaid_Grade_Level_score = RS(10).Value

        amp = CountChar(txt, "&")
        ex = CountChar(txt, "!")

        Worksheets("Sheet1").Cells(row, 3).Resize(1, 12).Value = _
              Array(Words, Characters, Paragraphs, Sentences, Sentences_per_paragraph, _
              Words_per_sentence, Characters_per_word, Ratio_of_passive_sentences, _
              Flesch_Reading_Ease_score, Flesch_Kincaid_Grade_Level_score, amp, ex)

        row = row + 1
    Loop
End Sub

Function CountChar(txt As String, char As String) As Long
    CountChar = Len(txt) - Len(Replace(txt, char, ""))
End Function