Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как-то можно стандартными средствами или через VBA достать список всех некорректно написанных слов?, Рецензирование - Орфография показывает эти слова один-за-другим, а мне нужно сразу весь список
 
#1
11.09.2023 16:28:48
Добрый день.
Если нажать Рецензирование - Орфография, выйдет окно и один за другим будет показывать некорректно (с точки зрения правописания) написанные слова и будет предлагать разные команды: "Пропустить", "Заменить" и т.д.

Вопрос:
Как-то можно стандартными средствами или через VBA достать список всех некорректно написанных слов?
 
 
 
#2
11.09.2023 16:38:16
Код
For Each cell In Selection
If Not Application.CheckSpelling(cell) Then Debug.Print cell
Next
По вопросам из тем форума, личку не читаю.
 
 
 
#3
11.09.2023 16:46:04
Я ступил, в ячейке будет много букафф.
Тогда остаётся каждое слово каждой ячейки загнать в пустую ячейку и проверить как предлагает БМВ?

Если текста много не задумается ли надолго xl?
 
 
 
#4
11.09.2023 16:52:11
Бахтиёр,
Код
Sub ORFO(Str As Long, Stlb As Long)
'Определим строку
j = 1
For i = 1 To Len(Cells(Str, Stlb).Value)
If i + 1 > Len(Cells(Str, Stlb).Value) Then
    If Application.CheckSpelling(Mid(Cells(Str, Stlb).Value, j, i - j + 1)) = False Then
   'Выделим
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.ColorIndex = 3
    Else
    'Восстановим цвет
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.Color = 0
    End If
Else
 If Mid(Cells(Str, Stlb).Value, i + 1, 1) = " " Or _
Asc(Mid(Cells(Str, Stlb).Value, i + 1, 1)) = 10 Or (i = Len(Cells(Str, Stlb).Value) And j = 1) _
Then
   If Application.CheckSpelling(Mid(Cells(Str, Stlb).Value, j, i - j + 1)) = False Then
   'Выделим
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.ColorIndex = 3
    Else
    'Восстановим цвет
   Cells(Str, Stlb).Characters(Start:=j, Length:=(i - j + 1)).Font.Color = 0
   End If
   j = i + 2
 End If
End If
Next i
End Sub
Sub проверить_диапазон()
    Dim cel As Range
    For Each cel In Selection.Cells
        ORFO CLng(cel.Row), CLng(cel.Column)
    Next
End Sub
 
'Ну и пропишем событие, например:
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
Call ORFO(Target.Row, Target.Column)
End Sub
У меня в модуле листа работает
 
 
 
#5
11.09.2023 17:05:11
Спасибо огромное всем.

Код ниже обработал 3409 слов за 29 секунд.
В принципе приемлемо для меня.
Код
Sub орфо()
Dim dic As New Dictionary
For Each cell In ActiveSheet.UsedRange
    For Each sp In Split(cell.Value, " ")
    n = n + 1
        If Not Application.CheckSpelling(sp) Then tmp = dic(sp)
    Next
Next
Workbooks.Add
[A1].Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.Keys)
End Sub
 
 
 
#6
12.09.2023 03:49:08
Цитата
Бахтиёр написал:
Код ниже обработал 3409 слов за 29 секунд.
А зачем в Вашем коде переменная n? Зачем Вы ее увеличиваете на 1 при каждой интерации?
Потестируйте такой код
Код
Sub орфо1()
Dim arr()
Dim I&, J&, tmp
arr = ActiveSheet.UsedRange.Value
With CreateObject("Scripting.Dictionary")
For I = LBound(arr, 1) To UBound(arr, 1)
    For J = LBound(arr, 2) To UBound(arr, 2)
        For Each sp In Split(arr(I, J), " ")
            If Not Application.CheckSpelling(sp) Then tmp = .Item(sp)
        Next
    Next
Next
Workbooks.Add
[A1].Resize(.Count) = Application.Transpose(.Keys)
End With
End Sub
Изменено: Sanja - 12.09.2023 07:23:22
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
12.09.2023 08:43:01
Цитата
Sanja написал:
For I = LBound(arr, 1) To UBound(arr, 1)    For J = LBound(arr, 2) To UBound(arr, 2)
это заменяется одним For Each даже по многомерному массиву..  Так как нужно читать только, то знание индекса не требуется.
По вопросам из тем форума, личку не читаю.
 
 
 
#8
12.09.2023 08:52:27
Ух ты, не знал. Век учись, как говорится. Спасибо за подсказку, Михаил!
Код
Sub ОРФО1()
Dim arr, tmp, iWorld
Application.ScreenUpdating = False
arr = ActiveSheet.UsedRange.Value
With CreateObject("Scripting.Dictionary")
    For Each iWorld In arr
        For Each sp In Split(iWorld, " ")
            If Not Application.CheckSpelling(sp) Then tmp = .Item(sp)
        Next
    Next
    Workbooks.Add
    [A1].Resize(.Count) = Application.Transpose(.Keys)
End With
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#9
12.09.2023 16:30:40
Ведмедь, ты крут! Тоже не знал.
 
 
 
Страницы: 1
Наверх