Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Дублирование строки под нужное условие, Производит дублирование всей строки, находит под условие
 
#1
16.05.2022 19:41:04
Здравствуйте! Прошу подсказать, как можно решить такой вопрос. Подскажите с макросом, который будет делать следующие шаги:-Находит нужную строку (строки) в массиве данных по определённому слову
- Дублирует данную строку полностью (строки)
- Переименовывает слово (по которому был сделан поиск) на требуемое (задается пользователем)
На примере прикрепляю файл:
Таблица с "было" и "стало", где был сделан поиск по слову "1 кв", далее строки были продублированы и переименованы на "1 кв.н".
Спасибо большое за помощь заранее!
 
 
 
#2
16.05.2022 21:29:27
Задание в таком виде - хороший повод всё сделать самому: записать все действия макрорекордером и потом слегка подрихтовать код вручную.
 
 
 
#3
17.05.2022 02:43:29
Код
Sub Дублирование_строки()
    Dim FindWord As String, ReplaceWord As String, Rng As Range, firstAddres As String
    
    FindWord = Application.InputBox("Какое слово найти в 3-м столбце?", "Поиск слова")
    If FindWord = Empty Then Exit Sub
    ReplaceWord = Application.InputBox("На какое слово заменить?", "Поиск слова")
    If ReplaceWord = Empty Then Exit Sub
    
    With ActiveSheet
        Set Rng = .Columns(3).Find(FindWord, , xlFormulas, xlWhole) 'xlWhole -ячейка целиком (xlPart - часть ячейки)
        If Rng Is Nothing Then
            MsgBox "Слово '" & FindWord & "' не найдено в 3-м столбце!", vbExclamation, "Внимание"
            Exit Sub
        End If
        firstAddres = Rng.Address
        Do
            .Rows(Rng.Row).Copy
            .Rows(Rng.Row + 1).Insert Shift:=xlDown
            .Cells(Rng.Row + 1, 3) = ReplaceWord
            Set Rng = .Columns(3).FindNext(Rng)
        Loop Until Rng.Address = firstAddres
    End With
    MsgBox "Сделано!", vbInformation, "Конец"
End Sub
 
 
 
#4
17.05.2022 08:50:09
Цитата
написал:
Sub Дублирование_строки()    Dim FindWord As String, ReplaceWord As String, Rng As Range, firstAddres As String         FindWord = Application.InputBox("Какое слово найти в 3-м столбце?", "Поиск слова")    If FindWord = Empty Then Exit Sub    ReplaceWord = Application.InputBox("На какое слово заменить?", "Поиск слова")    If ReplaceWord = Empty Then Exit Sub         With ActiveSheet        Set Rng = .Columns(3).Find(FindWord, , xlFormulas, xlWhole) 'xlWhole -ячейка целиком (xlPart - часть ячейки)        If Rng Is Nothing Then            MsgBox "Слово '" & FindWord & "' не найдено в 3-м столбце!", vbExclamation, "Внимание"            Exit Sub        End If        firstAddres = Rng.Address        Do            .Rows(Rng.Row).Copy            .Rows(Rng.Row + 1).Insert Shift:=xlDown            .Cells(Rng.Row + 1, 3) = ReplaceWord            Set Rng = .Columns(3).FindNext(Rng)        Loop Until Rng.Address = firstAddres    End With    MsgBox "Сделано!", vbInformation, "Конец"End Sub
Ого, отлично! Спасибо большое за помощь!
 
 
 
Страницы: 1
Наверх