拼写检查并在下一个单元格中获取建议的列表

时间:2016-03-11 08:50:04

标签: excel excel-vba vba

我正在使用以下代码进行范围内的拼写检查..

Sub SpellCheck()

Application.SpellingOptions.DictLang = 1033

Dim cel As Range, CellLen As Long, CurChr As Long, TheString As String
Dim a As Integer

For Each cel In Range("Spell[description]")

'splitting paragraph into words

    For CurChr = 1 To Len(cel.Value)
        If Asc(Mid(cel.Value, CurChr, 1)) = 32 Then
            If InStr(CurChr + 1, cel.Value, " ") = 0 Then
                TheString = Mid(cel.Value, CurChr + 1, Len(cel.Value) - CurChr)
            Else
                TheString = Mid(cel.Value, CurChr + 1, InStr(CurChr + 1, cel.Value, " ") - CurChr)
            End If
            'checking spell as per words
            If Not Application.CheckSpelling(Word:=TheString) Then

                cel.Characters(CurChr + 1, Len(TheString)).Font.Color = RGB(255, 0, 0)
                'updating the error words in the next sheet
                Sheets(2).Activate
                a = Cells(Rows.Count, 1).End(xlUp).Row
                Cells(a + 1, 1).Value = cel.Offset(0, -1).Value
                Cells(a + 1, 2).Value = TheString
            Else
                cel.Characters(CurChr + 1, Len(TheString)).Font.Color = RGB(0, 0, 0)
            End If
            TheString = ""
        End If
    Next CurChr

Next cel

End Sub

它将突出显示红色的错误字,并将其与sheet2中的ID和错误字一起更新。但是我需要在下一个单元格中更新excel为错误提供的建议值(在sheet2中的错误单词之后)。

我对VBA中的拼写检查完全不熟悉,任何人都可以帮我解决..!

0 个答案:

没有答案