Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос для поиска и замены текста / 14 сообщений из 14, страница 1 из 1
26.07.2007, 19:39:15
    #34687303
McGruber
McGruber
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Есть книга Excel.
Нужен макрос Sub replace(p1, p2, p3) , который бы в определённом столбце, допустим в A, искал ячейку с текстом p1 (она будет единственной) и при нахождении менял бы текст ячеек в столбцах B и C этой же строки на p2 и p3 соответственно.
Возможно кто-нибудь сможет помочь решить такую задачу?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.07.2007, 19:50:38
    #34687320
vbapro
vbapro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Sub MyReplace(p1 As String, p2 As String, p3 As String)
Dim R As Range

    Set R = Columns("A:A").Find(What:=p1)
    
    If Not R Is Nothing Then
        R.Offset( 0 ,  1 ).Value = p2
        R.Offset( 0 ,  2 ).Value = p3
    End If

    Set R = Nothing
    
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.07.2007, 00:16:13
    #34690886
KuskovS
KuskovS
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Как запустить этот макрос?))). Не получаеется, у меня! VBA вообще его не видит!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.07.2007, 09:40:11
    #34690949
vbapro
vbapro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
можно так
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.07.2007, 11:09:08
    #34690973
Deggasad
Deggasad
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Если вы не знаете макросы, то проще формулы написать в столбцах B и C да и всё!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
30.07.2007, 01:47:08
    #34691416
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Недавно решал подобную задачу, но с многократным вхождением данных. Может понадобится кому-нибудь...
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
   Sub MyReplace_2()
   Dim p1 As String, p2 As String, p3 As String
   Dim c As Range

   'оцениваем высоту массива
    intCountRow = ActiveSheet.UsedRange.Rows.Count
    
   'проводим поиск и замены
        With ActiveSheet.Range("A1:A" & CStr(intCountRow))
            Set c = .Find("p1", LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    Range(c.Address).Select
                    Selection.Offset( 0 ,  1 ).Value = "p2"
                    Selection.Offset( 0 ,  2 ).Value = "p3"
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
   
   End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
30.07.2007, 02:20:40
    #34691422
KL (XL)
KL (XL)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Вот вариант с многократным вхождением данных побыстрее :

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Sub MyProcedure(rngSerach As Range, strSearchValue, ParamArray arrValuesToAdd() As Variant)
    Dim c As Range
    Dim cnt As Long
    Dim i As Long
    
    cnt = Application.CountIf(rngSerach, strSearchValue)
    Set c = rngSerach( 1 )
    For i =  1  To cnt
        Set c = rngSerach.Find(strSearchValue, c)
        c.Offset(,  1 ).Resize(, UBound(arrValuesToAdd)) = arrValuesToAdd
    Next i
End Sub

Sub test()
    MyProcedure [A1:A20], "*test*",  10 ,  20 ,  30 ,  40 ,  50 
End Sub

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
30.07.2007, 03:06:02
    #34691428
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
KL (XL)Вот вариант с многократным вхождением данных побыстрее :
...


Спасибо. Быстрей надо, тем более, что массивы весьма приличные.
Если можно - пара вопросов:
- при выполнении макроса хотелось бы, чтобы высоту массива он оценивал сам. В Вашем варианте только 20 строк (нет желания делать форму для указания диапазона);
- пр выполнении макроса в соседние ячейки записываются все цифры кроме 50
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
30.07.2007, 04:07:53
    #34691437
KL (XL)
KL (XL)
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
SirFisher- при выполнении макроса хотелось бы, чтобы высоту массива он оценивал сам. В Вашем варианте только 20 строк (нет желания делать форму для указания диапазона);
См. ниже

SirFisher- пр выполнении макроса в соседние ячейки записываются все цифры кроме 50
Пардон, был неправ - ParamArray имеет базу 0, т.ч. надо прибавить единицу к UBound(arrValuesToAdd)

Как насчет такого:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Sub MyProcedure()
    Dim strSearchValue As String
    Dim arrValuesToAdd() As Variant
    Dim rngSerach As Range
    Dim c As Range
    Dim cnt As Long
    Dim i As Long
    
    strSearchValue = "*test*"
    arrValuesToAdd = Array( 10 ,  20 ,  30 ,  40 ,  50 )
    With ActiveSheet
        Set rngSerach = .Range(.Cells( 1 , "A"), .Cells(.Rows.Count, "A").End(xlUp))
        'On Error GoTo ErrHand
        'Set rngSerach = Intersect(.UsedRange, .Range("A:A"))
    End With
    
    cnt = Application.CountIf(rngSerach, strSearchValue)
    Set c = rngSerach( 1 )
    For i =  1  To cnt
        Set c = rngSerach.Find(strSearchValue, c)
        c.Offset(,  1 ).Resize(, UBound(arrValuesToAdd) +  1 ) = arrValuesToAdd
    Next i
'ErrHand:
End Sub

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
30.07.2007, 05:28:21
    #34691455
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
KL (XL)
Пойду поменяю свои выкладки, на имеющие бОльшую скорость работы. Спасибо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2007, 12:37:20
    #34697679
supaflyster
supaflyster
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Не подскажите как осуществить следующее...
Есть фаил с более чем 2000 строк в каждой строке есть поле с ссылкой на документ в каталоге с таблицей, изменили именование папок, теперь надо бы обновить все ссылки,руками это не реально а по CTRL+H он ссылки не меняет, как это можно организовать с помощью макроса? Спасибо!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2007, 12:42:11
    #34697693
supaflyster
supaflyster
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Забыл добавить...
Раньше было такое именование TM001/file_name.pdf
Теперь RS001/file_name.pdf
То есть нужно в ссылке изменить всего 2 буквы.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2007, 13:32:44
    #34697888
vbapro
vbapro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
supaflysterЗабыл добавить...
Раньше было такое именование TM001/file_name.pdf
Теперь RS001/file_name.pdf
То есть нужно в ссылке изменить всего 2 буквы.
как-нибудь так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
Sub test()
Dim HL As Hyperlink
    For Each HL In ActiveSheet.Hyperlinks
        If HL.Address Like "TM*.pdf" Then
            HL.Address = Replace(HL.Address, "TM", "RS")
        End If
    Next HL
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
01.08.2007, 14:14:42
    #34698097
supaflyster
supaflyster
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Макрос для поиска и замены текста
Спасибо большое! Выручили :)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Макрос для поиска и замены текста / 14 сообщений из 14, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 412ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2182523]:
 0ms
get settings:
 9ms
get forum list:
 19ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 61ms
get topic data:
 13ms
get forum data:
 3ms
get page messages:
 59ms
get tp. blocked users:
 2ms
others: 238ms
total:  412ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]