Страницы: 1
RSS
Поиск по одному параметру и последующее перемещение целой строки на второй лист, макрос
 
Добрый день! Очень срочно надо выполнить задание, но, как его выполнить, не знаю, поэтому обращаюсь к вам за помощью. В моем примере есть база данных по закупкам. Представим, что в таблице намного больше данных, поэтому поиск опреденной строки являтся затруднительным. Моя цель при вводе определенного "номера заказа", вся строка должна удалятся с первого листа и, соответственно переноситься на лист 2. Могу ли я это сделать с помощью макрорекодера? Если нет, то какой код я должна прописать в ВБА? Спасибо вам большое заранее!
 
Цитата
при вводе определенного "номера заказа"
Куда вы собираетесь вводить номер?
Цитата
вся строка должна удалятся с первого листа и, соответственно переноситься на лист 2
В какое место листа2 ? При этом на листе1 строки должны сдвигаться ?
 
Цитата
Kuzmich написал:
Куда вы собираетесь вводить номер
Условием является то, что мне будет дан только "номер заказа", по которому вся строчка, соответствующая данному номеру должна быть автоматически удалена из Лист1 и перенесена (не меняясь) в лист2. Тоесть я думала создать кнопку поиска по "номеру заказа" на листе1, и при вводе "номера заказа", процесс удаления и перенесения ВСЕЙ строки должен произойти автоматически. После перенесения строк, линии должны смещаться на листе1. Перенесенные строки на Лист2, могут просто идти по порядку. Спасибо вам большое за ответ!
 
Попробуйте так.

Код
Option Explicit

Sub test()
    Dim ZakazNum#, rng As Range
    Dim itxt$, lrow&
    On Error Resume Next
    itxt = Join(Array("Номер заказа введеен некорректно", "хотите повторить?", _
        "[Да] - повторить", "[Нет] - завершить"), vbNewLine)
    Do
        Err.Clear
        ZakazNum = InputBox("№ заказа", "Введите данные о заказе", "Заказ №")
        If Err.Number <> 0 Then
            If MsgBox(itxt, vbYesNo + vbCritical) = vbNo Then Exit Sub
        End If
    Loop Until Err.Number = 0
    Set rng = Worksheets("Sheet1").Columns("a").Find(ZakazNum)
    lrow = Worksheets("Лист1").Range("a" & Worksheets("Лист1").Rows.Count).End(xlUp).Row + 1
    If Not rng Is Nothing Then
        Worksheets("Sheet1").Rows(rng.Row).Copy Worksheets("Лист1").Rows(lrow)
        Worksheets("Sheet1").Rows(rng.Row).Delete
    Else
        MsgBox "Указанный № акта отсутствует в таблице!!!", vbInformation
    End If
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
На листе Sheet1 создан элемент управления Поле со списком, заполненный номерами заказов.
Двойной клик по выбранному элементу в списке переносит эту строку с этим номером  на лист КудаПеренести
Страницы: 1
Наверх