Необходимо было реализовать обработку заказов стройматериалов по объектам. Диспетчер принимает заказы и вносит их в свою книгу "Заказы", заполняя колонки Дата, Объект, Наименование, Единица измерения, Количество, Срочность, Менеджер (тут она выбирает в зависимости от вида стройматериала, за каждым из них закреплен свой менеджер), колонки "Сроки" и "Статус" она не заполняет. В книге менеджера необходимо было обеспечить проверку книги "Заказы" на наличие заявок конкретному менеджеру (по столбцу "Менеджер"), после чего скопировать все данные оттуда, а после обработки заявки менеджер проставляет у себя сроки реализации заявки и Статус (пустой - это необработанный, "в работе" и "исполнено"). После того как менеджер обработает заявку необходима передача параметров "Сроки" и "Статус" обратно диспетчеру, в книгу "Заказы". В примере менеджера зовут Валера, соответственно его книга также называется "Валера".
Обе книги лежат на сервере, данные по приему заказов в книгу менеджера выполняются. Вот с обратной задачей возникли сложности, почему-то дата передается, а статус исполнения заказа (столбец
I) не сохраняется. Подскажите, пожалуйста, что не так с макросом книги "Заказы".
Использую Excel 2007
Скрытый текст |
|---|
Sub Кнопка1_Щелчок()
Dim ValeraSource As Excel.Workbook, shSource, shValera As Excel.Worksheet
Dim Valera_End As Long, Orders_End As Long
Dim j, k As Long
' Присвоение листу-результату VBA-имени "shSource".
' С помощью этого имени можно будет обращаться к листу-результату в коде.
Set shSource = Worksheets("Заказы")
' Открытие основной базы
' Присвоение файлу-источнику VBA-имени "bkSource".
' С помощью этого имени можно будет обращаться к файлу-источнику в коде.
' ReadOnly:=True - чтобы меньше было непредсказуемых событий.
Set ValeraSource = Workbooks.Open(Filename:="\\SERVER\Obmen\Заказы\Валера.xlsm", ReadOnly:=True)
Set shValera = ValeraSource.Worksheets("Валера")
Valera_End = shValera.UsedRange.Row + shValera.UsedRange.Rows.Count - 1
' Определение последней строки в основной базе данных
Orders_End = shSource.UsedRange.Row + shSource.UsedRange.Rows.Count - 1
' Движение по строкам основной базы
For j = 2 To Orders_End Step 1
'Ищем незаполненный заказ Валеры
If shSource.Cells(j, "G").Value <> "Валера" Then
' Переход к следующей строке на листе-источнике.
GoTo metka
End If
' Если оказались здесь, значит в ячейке слово "Валера". Проверяем, проставлены ли дата поставки И статус заказа
If (shSource.Cells(j, "H").Value <> "" And shSource.Cells(j, "I").Value <> "") Then
' Переход к следующей строке на листе-источнике, ибо эта заполнена
GoTo metka
End If
' Если оказались здесь, значит в ячейке слово "Валера" и статус и/или дата поставки НЕ проставлены
' Функциональная часть.
For k = 2 To Valera_End Step 1
'Ищем статус и сроки исполнения по данному заказу
If ((shSource.Cells(j, "A").Value = shValera.Cells(k, "A").Value) And (shSource.Cells(j, "C").Value = shValera.Cells(k, "C").Value)) Then
' подозрение на нужную запись
If (((shSource.Cells(j, "B").Value = shValera.Cells(k, "B").Value) And (shSource.Cells(j, "D").Value = shValera.Cells(k, "D").Value) And (shSource.Cells(j, "E").Value = shValera.Cells(k, "E").Value) And (shSource.Cells(j, "F").Value = shValera.Cells(k, "F").Value))) And ((shValera.Cells(k, "H").Value <> "") Or (shValera.Cells(k, "H").Value <> "")) Then
' теперь запись найдена однозначно, 100% совпадение, значит копируем сроки исполнения заказа и статус
shSource.Cells(j, "H").Value = shValera.Cells(k, "H").Value
shSource.Cells(j, "I").Value = shValera.Cells(k, "I").Value
End If
End If
Next k
metka: Next j
' Закрытие файла-источника.
ValeraSource.Close SaveChanges:=False
' Включение обновления монитора.
Application.ScreenUpdating = True
' Сообщение, чтобы было понятно, что макрос сделал работу.
MsgBox "Макрос завершил работу.", vbInformation
End Sub |
