Страницы: 1
RSS
Макрос для поиска и замены текста
 
Добрый день! Проблема заключается в следующем: из программы выгружается файл, в этом файле много документов, в каждом документе есть комиссия, ее нужно заменить на другую (проблема не столько в замене имен, сколько в расстоянии между строками, т.к. такое факсимиле сделали, что строчки приходятся расширять), и сразу после вставки удалить 8 строк под комиссией.
В примере на листе 1 сам файл с документами, а на листе 2 документ с правильной комиссией.
Очень прошу Вашей помощи!
 
Попробуйте макрос в стандартном модуле, только на листе 2 поставьте двоеточие в ячейке А51 Председатель комиссии,
как на листе 1. Komis2 - диапазон листа 2 A51:AI60 - прописать как имя в диспетчере
Код
Sub Zamena()
Dim FoundPredsedatel As Range
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim FirstPred As String
Dim n As Integer
  Set Sh1 = Worksheets("Лист 1")
  Set Sh2 = Worksheets("Лист 2")
    Set FoundPredsedatel = Sh1.Columns(1).Find("Председатель комиссии:", , xlValues, xlWhole)
      If Not FoundPredsedatel Is Nothing Then
         FirstPred = FoundPredsedatel.Address 'адрес первого вхождения
           Do
    Range("Komis2").Copy Sh1.Cells(FoundPredsedatel.Row, 1)
        For n = 0 To 9
            Sh1.Cells(FoundPredsedatel.Row + n, 1).RowHeight = Sh2.Cells(51 + n, 1).RowHeight
        Next
    Sh1.Range(Sh1.Cells(FoundPredsedatel.Row + 10, 1), Sh1.Cells(FoundPredsedatel.Row + 18, 35)).Delete
             Set FoundPredsedatel = Sh1.Columns(1).FindNext(FoundPredsedatel)
           Loop While FoundPredsedatel.Address <> FirstPred
      End If
End Sub
 
Большое спасибо!
Применила макрос к большому файлу, он все заменил, но выдал в конце ошибку и еще почему-то изменил ширину строк в ненужных местах. Почему так? (

Картинки удалены: превышение допустимого размера вложения [МОДЕРАТОР]
Изменено: tealoverr - 28.04.2015 00:26:14
 
Вы вставили  на листе 2  двоеточие в ячейке А51?
Д.б. Председатель комиссии:
 
Прошу прощения, сто раз переделывала и забыла поставить. Двоеточие решает проблему с ошибкой, а ползущие строчки остаются :(
 
Подсчитайте суммарную высоту строк 51-68 на первом листе для первой комиссии
и суммарную высоту строк 51-60 на втором листе для второй комиссии. Они должны
совпадать, тогда не будет сползания строк на листе.
Подберите высоту строк для второй комиссии.
 
Сделала, все равно все ползет ((
 
Для диапазона Komis2 предполагалось
='Лист 2'!R51C1:R60C35   а у вас с 51 по 61.
и в макросе изменить 18 на 17. 10 строк заменили и 8 строк удалили
Код
    Sh1.Range(Sh1.Cells(FoundPredsedatel.Row + 10, 1), Sh1.Cells(FoundPredsedatel.Row + 17, 35)).Delete
Изменено: Kuzmich - 27.04.2015 15:08:30
 
Я все так сделала, но ничего не меняется. После применения макроса ряд строк уменьшается с 13,20 до 9,60 в высоту, наверное поэтому все едет  
 
Код
    Sh1.Range(Sh1.Cells(FoundPredsedatel.Row + 10, 1), _
              Sh1.Cells(FoundPredsedatel.Row + 17, 35)).EntireRow.Delete
 
СПАСИБО СПАСИБО СПАСИБО ОГРОМНОЕ!
Страницы: 1
Наверх