Доброго времени суток! Дамы и господа прошу помочь доработать макросы или возможно у Вас найдутся другие свежие идеи. Есть файл по организации склада хранения проб, пробы хранятся на стеллажах, у каждого стеллажа есть своя «карточка хранения пробы», также на одном стеллаже может быть не одна проба. Заполнив «карточку» по новой пробе нажимаем «сохранить» срабатывает макрос записи пробы в таблицу листа «База» ища последнюю строчку и присваивая пробе индивидуальный порядковый номер (можно заменить на генератор или шифр любого плана, не принципиально, главное, чтобы потом не повторился). Далее, допустим, для пробы изменился статус или поменялось место хранения, вносим изменения в карточку и нажимаем «сохранить», далее согласно индивидуальному номеру, который указывается в ячейке G5 данной карточки, на листе «База» находится строка (макросом, он есть) с данными о пробе и производится замена измененных данных. Макросы для внесения или изменения данных по карточкам постарался сделать «безликими», так как их, вероятно, будет очень много и плодить макросы с привязкой к каждой новой карточке мне кажется не правильным. Остались не решенные вопросы: 1. Внесение номера новой пробы в карточку, при создании ее на листе «База». 2. Если добавляем номер в ячейку G5 (любая из карточек) и нажимаем сохранить, через диалоговое окно «Сохранить изменения?», если нажимаем «Ок» запускается макрос на внесение изменений в листе «База», однако при нажатии «Отмена», выдает сообщение «Такого номера пробы нет!» - необходимо, чтобы данное сообщение выводилось только в случае, если реально ее нет в базе при этом мы оставались на этом активном листе (какой-либо из карточек, сейчас перебрасывает в «Базу»). 3. Если добавляем номер в ячейку G5 (любая из карточек) и нажимаем сохранить, через диалоговое окно «Сохранить изменения?», если нажимаем «Ок» запускается макрос на внесение изменений в листе «База». Необходимо, чтобы мы оставались на активном листе (какой-либо из карточек, сейчас перебрасывает в «Базу»). 4. Необходимо, чтобы при внесении изменений через карточку по уже имеющемуся номеру, замене подлежали не только данные окна «Статус», но и все остальные значения, так сказать обновлялись. (просто предвосхищаю возникновение будущих задач, в которых понадобиться менять и эти значения).
Заранее все откликнувшимся, низкий поклон.
Доброго времени суток! Дамы и господа прошу помочь доработать макросы или возможно у Вас найдутся другие свежие идеи. Есть файл по организации склада хранения проб, пробы хранятся на стеллажах, у каждого стеллажа есть своя «карточка хранения пробы», также на одном стеллаже может быть не одна проба. Заполнив «карточку» по новой пробе нажимаем «сохранить» срабатывает макрос записи пробы в таблицу листа «База» ища последнюю строчку и присваивая пробе индивидуальный порядковый номер (можно заменить на генератор или шифр любого плана, не принципиально, главное, чтобы потом не повторился). Далее, допустим, для пробы изменился статус или поменялось место хранения, вносим изменения в карточку и нажимаем «сохранить», далее согласно индивидуальному номеру, который указывается в ячейке G5 данной карточки, на листе «База» находится строка (макросом, он есть) с данными о пробе и производится замена измененных данных. Макросы для внесения или изменения данных по карточкам постарался сделать «безликими», так как их, вероятно, будет очень много и плодить макросы с привязкой к каждой новой карточке мне кажется не правильным. Остались не решенные вопросы: 1. Внесение номера новой пробы в карточку, при создании ее на листе «База». 2. Если добавляем номер в ячейку G5 (любая из карточек) и нажимаем сохранить, через диалоговое окно «Сохранить изменения?», если нажимаем «Ок» запускается макрос на внесение изменений в листе «База», однако при нажатии «Отмена», выдает сообщение «Такого номера пробы нет!» - необходимо, чтобы данное сообщение выводилось только в случае, если реально ее нет в базе при этом мы оставались на этом активном листе (какой-либо из карточек, сейчас перебрасывает в «Базу»). 3. Если добавляем номер в ячейку G5 (любая из карточек) и нажимаем сохранить, через диалоговое окно «Сохранить изменения?», если нажимаем «Ок» запускается макрос на внесение изменений в листе «База». Необходимо, чтобы мы оставались на активном листе (какой-либо из карточек, сейчас перебрасывает в «Базу»). 4. Необходимо, чтобы при внесении изменений через карточку по уже имеющемуся номеру, замене подлежали не только данные окна «Статус», но и все остальные значения, так сказать обновлялись. (просто предвосхищаю возникновение будущих задач, в которых понадобиться менять и эти значения).
Sub ertert() Dim r As Range, nKart&, arr nKart = Range("G5").Value 'Порядковыйномер Значение1 Значение2 Значение3 Значение4 Ответсвенный Статус Территорияхранения Место№ If nKart > 0 Then arr = Array(nKart, [d9], [d7], [e11], [e16], [f14], [e19], [e21], [e23]) Set r = Sheets("База").Columns(1).Find(nKart, LookIn:=xlValues, lookat:=xlWhole) If r Is Nothing Then If MsgBox("Такого номера в базе нет" & vbCrLf & "Делаем новую запись?", 36) = vbNo Then Exit Sub Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(, 9).Value = arr Else If MsgBox("Хотите изменить запись № " & nKart & "?", 36) = vbNo Then Exit Sub r.Resize(, 9).Value = arr End If Else With Sheets("База") nKart = WorksheetFunction.Max(.Range("A9", .Cells(Rows.Count, 1).End(xlUp)(2, 1))) + 1 End With arr = Array(nKart, [d9], [d7], [e11], [e16], [f14], [e19], [e21], [e23])
If MsgBox("Создаем запись № " & nKart & "?", 36) = vbNo Then Exit Sub Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(, 9).Value = arr End If End Sub
Sub ertert() Dim r As Range, nKart&, arr nKart = Range("G5").Value 'Порядковыйномер Значение1 Значение2 Значение3 Значение4 Ответсвенный Статус Территорияхранения Место№ If nKart > 0 Then arr = Array(nKart, [d9], [d7], [e11], [e16], [f14], [e19], [e21], [e23]) Set r = Sheets("База").Columns(1).Find(nKart, LookIn:=xlValues, lookat:=xlWhole) If r Is Nothing Then If MsgBox("Такого номера в базе нет" & vbCrLf & "Делаем новую запись?", 36) = vbNo Then Exit Sub Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(, 9).Value = arr Else If MsgBox("Хотите изменить запись № " & nKart & "?", 36) = vbNo Then Exit Sub r.Resize(, 9).Value = arr End If Else With Sheets("База") nKart = WorksheetFunction.Max(.Range("A9", .Cells(Rows.Count, 1).End(xlUp)(2, 1))) + 1 End With arr = Array(nKart, [d9], [d7], [e11], [e16], [f14], [e19], [e21], [e23])
If MsgBox("Создаем запись № " & nKart & "?", 36) = vbNo Then Exit Sub Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1).Resize(, 9).Value = arr End If End Sub
Шикарная штука!!! Все работает и при этом все остальное тоже работает! nilem, про таких людей как Вы говорят, что у этого человека голова не только чтобы в нее есть. Светлая голова!!! Премного благодарен
А вот при новой записи, можно, чтобы ее номер появлялся в ячейке G5?
nilem,
Шикарная штука!!! Все работает и при этом все остальное тоже работает! nilem, про таких людей как Вы говорят, что у этого человека голова не только чтобы в нее есть. Светлая голова!!! Премного благодарен
А вот при новой записи, можно, чтобы ее номер появлялся в ячейке G5?Булат
Уважаемые форумчане! Есть вопрос в продолжении темы Организации склада. Подскажите пожалуйста, можно ли в этом файле сделать, допустим в ячейке E11, будет надпись "Добавить файл" нажимаем, открывается окно, в которой можно перетащить файл и он упадет в заранее подготовленную папку. Ну типа документы по пробе, которые мы можем посмотреть потом нажав на ячейку E11. Я просто раньше не видел такой реализации в Excel, думал как решить и возник вопрос: "А возможно ли вообще это реализовать?".
Уважаемые форумчане! Есть вопрос в продолжении темы Организации склада. Подскажите пожалуйста, можно ли в этом файле сделать, допустим в ячейке E11, будет надпись "Добавить файл" нажимаем, открывается окно, в которой можно перетащить файл и он упадет в заранее подготовленную папку. Ну типа документы по пробе, которые мы можем посмотреть потом нажав на ячейку E11. Я просто раньше не видел такой реализации в Excel, думал как решить и возник вопрос: "А возможно ли вообще это реализовать?".Булат
Сообщение отредактировал Булат - Суббота, 21.01.2017, 05:51
Да, спасибо, с этим я сразу разобрался, там по проекту будет много строк. Возможно коряво выразился, имел ввиду можно ли скопировать из ячейки "Карточки" в ячейку "База" не значение, а допустим ссылку.
Да, спасибо, с этим я сразу разобрался, там по проекту будет много строк. Возможно коряво выразился, имел ввиду можно ли скопировать из ячейки "Карточки" в ячейку "База" не значение, а допустим ссылку.Булат
Насчет этого не знаю даже, вроде ка подходит по теме, ведь всеми этими манипуляциями мы и организовываем склад. Просто не стал нагружать стартовое сообщение в теме. Извиняйте, если что.
Насчет этого не знаю даже, вроде ка подходит по теме, ведь всеми этими манипуляциями мы и организовываем склад. Просто не стал нагружать стартовое сообщение в теме. Извиняйте, если что.Булат
Уважаемый, nilem, помогите пожалуйста с вашим чудесным кодом Можно ли его модернизировать, чтобы из ячеек можно было копировать не только значения, а еще формулы и гиперссылки. Например из E11 формула, из E16 гиперссылка, остальные значением. Спасибо!
Уважаемый, nilem, помогите пожалуйста с вашим чудесным кодом Можно ли его модернизировать, чтобы из ячеек можно было копировать не только значения, а еще формулы и гиперссылки. Например из E11 формула, из E16 гиперссылка, остальные значением. Спасибо!Булат
Sub ertert() Dim r As Range, nKart&, arr nKart = Range("G5").Value 'Порядковыйномер Значение1 Значение2 Значение3 Значение4 Ответсвенный Статус Территорияхранения Место№ If nKart > 0 Then arr = Array(nKart, Range("D9").Formula, [d7], [e11], [e16], [f14], [e19], [e21], [e23], [e25]) Set r = Sheets("База").Columns(1).Find(nKart, LookIn:=xlValues, lookat:=xlWhole) If r Is Nothing Then If MsgBox("Такого номера в базе нет" & vbCrLf & "Делаем новую запись?", 36) = vbNo Then Exit Sub With Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1) .Resize(, 10).Value = arr Range("E16").Copy .Offset(, 4) 'копируем в Значение4 End With Else If MsgBox("Хотите изменить запись № " & nKart & "?", 36) = vbNo Then Exit Sub r.Resize(, 10).Value = arr Range("E16").Copy r.Offset(, 4) 'копируем в Значение4 End If Else With Sheets("База") nKart = WorksheetFunction.Max(.Range("A9", .Cells(Rows.Count, 1).End(xlUp)(2, 1))) + 1 End With arr = Array(nKart, Range("D9").Formula, [d7], [e11], [e16], [f14], [e19], [e21], [e23], [e25]) If MsgBox("Создаем запись № " & nKart & "?", 36) = vbNo Then Exit Sub With Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1) .Resize(, 10).Value = arr Range("E16").Copy .Offset(, 4) 'копируем в Значение4 End With Range("G5").Value = nKart End If End Sub
[/vba]
Видите какой некрасивый код из-за копирования? Ужс
ну разве что копировать ячейку, попробуйте
[vba]
Код
Sub ertert() Dim r As Range, nKart&, arr nKart = Range("G5").Value 'Порядковыйномер Значение1 Значение2 Значение3 Значение4 Ответсвенный Статус Территорияхранения Место№ If nKart > 0 Then arr = Array(nKart, Range("D9").Formula, [d7], [e11], [e16], [f14], [e19], [e21], [e23], [e25]) Set r = Sheets("База").Columns(1).Find(nKart, LookIn:=xlValues, lookat:=xlWhole) If r Is Nothing Then If MsgBox("Такого номера в базе нет" & vbCrLf & "Делаем новую запись?", 36) = vbNo Then Exit Sub With Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1) .Resize(, 10).Value = arr Range("E16").Copy .Offset(, 4) 'копируем в Значение4 End With Else If MsgBox("Хотите изменить запись № " & nKart & "?", 36) = vbNo Then Exit Sub r.Resize(, 10).Value = arr Range("E16").Copy r.Offset(, 4) 'копируем в Значение4 End If Else With Sheets("База") nKart = WorksheetFunction.Max(.Range("A9", .Cells(Rows.Count, 1).End(xlUp)(2, 1))) + 1 End With arr = Array(nKart, Range("D9").Formula, [d7], [e11], [e16], [f14], [e19], [e21], [e23], [e25]) If MsgBox("Создаем запись № " & nKart & "?", 36) = vbNo Then Exit Sub With Sheets("База").Cells(Rows.Count, 1).End(xlUp)(2, 1) .Resize(, 10).Value = arr Range("E16").Copy .Offset(, 4) 'копируем в Значение4 End With Range("G5").Value = nKart End If End Sub
[/vba]
Видите какой некрасивый код из-за копирования? Ужс nilem
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
, пробую еще раз
Осталась гиперссылка 
