Добрый день Помогите пожалуйста с макросом. Задача простая,чтобы при вводе даты снятия с учета или списания данные из вкладки база вырезались и переносились во вкладку архив. Заранее спасибо
Инженер01, изменить название темы это только начало. Потом прибегут старожилы и ссылаясь на пункт 2.7. Правил. Попросят Вас в раздел "Работа".
Если всё-таки сами собираетесь писать макрос, то лучше конкретизировать в чём именно проблема. Алгоритмически Вам на листе нужно: 1. Создать событие onChange; 2. Проверить в нём изменился ли нужный столбец; 3. Строки по которым произошли изменения вырезать и вставить на лист "Архив".
Ну или не мучатся с onChange, а просто добавить кнопку, по нажатии на которую будет просматриваться вся таблица и нужные строки переноситься.
Первый раз на форуме не совсем понимаю что и к чему Прописывать макросы не умею,все познания ограничиваются меседжем в начале работы))) Предприятие крупное более 1500 ед.техники и не всегда удобно все вырезать и переносить
Инженер01, я работал в ПТО 3 года (даже начальником успел побыть). Там просто нужен строгий учёт и контроль По макросу: сделал решение в "умных" таблицах через двойной клик по базе — пробуйте.
Макрос в модуль листа «База»
Код
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim shArch As Worksheet
Dim iData As Date
Dim nr&
On Error GoTo fin
If Intersect(Target, [_DB]) Is Nothing Or Target.Row < 2 Then GoTo fin
On Error GoTo ex
iData = Application.InputBox("Введите дату, используя в качестве разделителей «-» или «/»", "Введите ДАТУ", Format(Date, "dd-mm-yy"), Type:=1)
If iData < 1 Then GoTo ex
Application.ScreenUpdating = 0
On Error GoTo er
Set shArch = Worksheets("Архив")
nr = [_rArch].Count + 2
If nr = 3 And WorksheetFunction.CountA([_Archive]) < 1 Then nr = 2
ReDim arr(1 To 1, 1 To 3)
arr = Range("A" & Target.Row & ":C" & Target.Row).Value
ReDim Preserve arr(1 To 1, 1 To 4): arr(1, 4) = iData
shArch.Range("A" & nr).Resize(1, 4).Value = arr
Target.EntireRow.Delete
GoTo fin
er:
MsgBox "КРИТИЧЕСКАЯ ОШИБКА!", vbCritical, "FATAL ERROR"
ex:
MsgBox "Отмена выполнения", vbInformation, "CANCEL"
fin:
On Error GoTo 0
Application.ScreenUpdating = 1
End Sub
в файле макрос уже есть — просто кликните 2 раза в области таблицы базы
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Wiss, спасибо — что-то видно пошло не так в тот раз файл и код макроса под спойлером в #10 заменил Инженер01, адаптируйте, обращайтесь А также внимательно изучите правила форума и прокомментируйте тут вариант от yozhik — не обесценивайте усилия помогающих
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄