VBA поиск и замена скрипта вызывают большие задержки

Question

[[ОБНОВЛЕНИЕ: Извинения ... Я забыл блок кода.Отредактировано.]]

Это вопрос одного из моих преподавателей, поэтому я процитирую его прямо и предисловие, сказав, что я не знаю В.Б. (только канал):

"Чтобы помочь иностранному студенту, мне нужно преобразовать транскрипты Youtube и скрытые субтитры в читаемый текст.

Я написал эту процедуру с целью удаления меток временного кода из транскриптов Youtube, вызывая Visual Basic изв Microsoft Word. Поскольку временные коды всегда находятся на отдельной строке и временные коды должны содержать «:», я ищу символ «:», а затем удаляю всю строку, в которой он встречается. По какой-то причине процедура Iпосле завершения написания вынуждает Word перевести его в длительное время без ответа (около 60-100 секунд), после которого оно работает на отлично. Любые предложения о том, как избежать этой задержки или решить эту проблему в Word без написания макросов? "

Sub Deleteyt()

Dim oRng As Word.Range

Dim oRngDelete As Word.Range

Set oRng = ActiveDocument.Range

With oRng.Find

.Text = ":"

While .Execute

oRng.Select

Set oRngDelete = ActiveDocument.Bookmarks("\Line").Range

oRngDelete.Delete

Wend

End With

End Sub

Итак, код работает, впереди просто большая задержка.Есть идеи?

Answer 1

Для этого вам не нужен макрос - все, что вам нужно - это подстановочный знак Найти / заменить, используя:

Find = <[0-9]@:[0-9]@>*^13
Replace = nothing

Answer 2

Почему бы не изменить текстовый файл, содержащий стенограмму?Я ожидаю, что в итоге вы получите файл .txt.

См. Пример ниже, сильно закаленный от: Текстовый файл в VBA: Открыть / Найти Заменить / Сохранить как / Закрыть файл

Sub CleanFile()

Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String

' Edit as needed
sFileName = application.GetOpenFilename

iFileNum = FreeFile
Open sFileName For Input As iFileNum

Do Until EOF(iFileNum)
    Line Input #iFileNum, sBuf
    'If the line does not contain a ':', then include the line in the memory sTemp 
    if If InStr(sBuf, ":") = 0 Then sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum

iFileNum = FreeFile

sFileName = Application.GetSaveAsFilename()
Open sFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum

End Sub