Страницы: 1
RSS
Поиск и замена текста в txt файле
 
Прошу не ругаться. Есть текстовый файл, в нем нужно найти определенный текст и заменить на другой. С поисками есть алгоритмы, а вот с заменой хуже....  :(  Прошу помощи, господа....  Кое что тут нашел, но разобраться не могу (
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Function SearchInRange(oDoc, oRng, obook, l As Object) As Boolean
Dim klop As Object, Z As Boolean
Set klop = l
'Задаем цикл и потом передаем параметры в функцию DoReplace
 With oRng.Find
 .Text = "[[]?*[]]"
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchWildcards = True
 .Execute
End With
Do While oRng.Find.Found = True
'oRng.Find.Execute
 If Not oRng = "" Then Codes = oRng
 'If Not oRng = "" Then Codes = Mid(oRng, 2, Len(oRng) - 2)
Set sRow = obook.Sheets(1).Cells.Find(What:=Codes, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
 :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
 False, SearchFormat:=False)
If Not sRow Is Nothing Then
 sRow = sRow.Row
 Values = obook.Sheets(1).Range("B" & sRow).Value
 If Len(Values) > 240 Then Values = Left(Values, 240)
 Call DoReplace(klop:=klop, strFind:=oRng, strReplace:=Values)
Else:
 oRng.HighlightColorIndex = wdRed ' Заливаем проблемные коды красным
 If Not oRng = "" Then Codes = Mid(oRng, 2, Len(oRng) - 2)
 Values = Chr(34) & Codes & Chr(34)
 Call DoReplace(klop:=klop, strFind:=oRng, strReplace:=Values)
End If
oRng.Find.Text = "[[]?*[]]"
oRng.Find.Forward = True
oRng.Find.Wrap = wdFindContinue
oRng.Find.Format = False
oRng.Find.MatchWildcards = True
oRng.Find.Execute
Loop
End Function
Изменено: sesahar - 08.02.2014 00:47:35
 
Вы открываете текстовый файл в Word, а управляете поиском-заменой из Excel?
Опишите задачу словами, приложите файлы.
 
Как насчет использования регулярных выражений в Word?
 
Цитата
Казанский пишет:
Вы открываете текстовый файл в Word, а управляете поиском-заменой из Excel?
Нет, файл именно текстовый txt (блокнот :) ) . Уже была мысль с начала считать информацию в ексель, сделать в нем замену и записать обратно. Считывать получается, а вот с заменой никак (
 
А фотографии редактировать в Екселе еще не пробовали??? А че, подходящий инструмент...
Если автоматизировать бардак, то получится автоматизированный бардак.
 
Цитата
wowick пишет:
А фотографии редактировать в Екселе еще не пробовали??? А че, подходящий инструмент...
Спасибо за издевательство... Мне всего лишь нужно выполнить поиск и замену подстроки в строке... без разницы буду я это делать в тексте, или в ячейках в экселе.... Вот макрос, который подсвечивает подстроку, все работает, вот мне бы только вместо подсветки делать замену на другую подстроку....

Sub Find_n_Highlight()
    On Error Resume Next: Err.Clear
    Dim ra As Range, cell As Range, res, txt$, v, pos&
    res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "диз" ;)
    If VarType(res) = vbBoolean Then Exit Sub    ' нажата кнопка ОТМЕНА
   txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub    ' текст не введен, или состоит из пробелов

    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))    ' диапазон для поиска
   Application.ScreenUpdating = False
    ra.Font.Color = 0: ra.Font.Bold = 0  ' сброс цветового выделения

    For Each cell In ra.Cells    ' перебираем все ячейки
       pos = 1
        If cell.Text Like "*" & txt & "*" Then
            arr = Split(cell.Text, txt, , vbTextCompare)   ' разбивает текст ячейки на части
           If UBound(arr) > 0 Then    ' если подстрока найдена
               For Each v In arr    ' перебираем все вхождения
                   pos = pos + Len(v)    ' начальная позиция
                   With cell.Characters(pos, Len(txt))
                        .Font.ColorIndex = 3    ' выделяем цветом
                       .Font.Bold = True    ' и полужирным начертанием
                   End With
                    pos = pos + Len(txt)
                Next v
            End If
        End If
    Next cell
End Sub
 
sesahar, оформляйте коды тегом.
 
Код vbs:

Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Const ForReading = 1
Const ForWriting = 2
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("c:\test.txt", ForReading)
 
strText = objFile.ReadAll
objFile.Close
 
strText = Replace(strText, ",", " ")
 
Set objFile = objFSO.OpenTextFile("c:\test.txt", ForWriting)
objFile.Write strText
objFile.Close
 
дедовский способ ещё не отменяли...

Код
1
2
3
4
5
6
7
8
9
Private Sub Комманда1_Click()
   Open "C:\test.txt" For Binary As #1
    CF = Input(FileLen("C:\test.txt"), 1)
   Close #1
   CF = Replace(CF, ",", "!")
   Open "C:\test2.txt" For Output As #1
   Print #1, CF
   Close #1
End Sub

Вместо "," искомый текст. Вместо "!" то, что нужно подставить!
С подсветкой, конечно, красивше будет!!
Изменено: Александр Моторин - 09.02.2014 15:16:23
Страницы: 1
Читают тему
Loading...