Добрый день, знатоки! Подсобите, пожалуйста, в очередной раз решить проблему. В файле примере на лист "BAZA" по мере готовности вносятся номера контрактов, на листе "Журнал учета" макросом копируются необходимые данные по этим сотрудникам, т.е. по вновь созданным контрактам. Но у меня возникает загвоздка с работой макроса. Поясню: допустим, сегодня отработаны контракты №№15 и 18 и они в столбце расположены друг за другом, т.е. по возрастанию и в этом случае при нажатии кнопки макрос отрабатывает верно и копирует нужные данные на лист, НО если последующие контракты(номера контрактов), в примере это №№19-21, расположены не по принципу возрастания, т.е. не сверху вниз, то макрос копирует первый попавшийся бОльший номер (в данном случае больше 18) №21 и заканчивает работу, а номера 19 и 20 так и остаются нескопированными. Как подправить макрос, чтобы он работал как нужно?
Если это имеет значение: фактическое кол-во столбцов на листе BAZA значительно больше, удалил для уменьшения веса файла.
Добрый. Может быть вы словами опишете, чего вы хотите получить в результате из исходных данных, а мы новый макрос напишем? Чем перебирать, проще искать номера контрактов в имеющемся журнале - если не нашел - вписывать новую строку, иначе - ничего не делать. Уникальный признак - номер контракта же, правильно?
Пытливый, хм, даже смутили меня. Не знаю как более точно описать проблему, чем она описана выше. Да, уникальный признак - номер контракта. Спасибо, что откликнулись!
А вы не описывайте проблему, вы задачу опишите. Что должен делать макрос. Простыми словами. Например: Макрос должен с листа... сравнить данные с данными на листе... и если... то.... а потом так... а он ему... о она ему - ннна! и на лошадках потом тыг-дым, тыг-дым, тыг-дым. Как-то так, в общем.
P.S. из столбцов на BAZA только эти данные должны попадать в журнал, как в примере?
Пытливый, Тыг-дым, тыг-дым, думаю не потребуется - вряд ли задачка настолько тяжела. А нужно, чтобы макрос копировал на лист столбцы с листа BAZA по номеру контракта. Есть, например, уже копированные данные под номером "2021-18", после копирования этого номера, допустим на следующий день внесены записи под номерами 19-21, так вот нужно чтобы макрос скопировал нужные данные и для этих (в данном случае трех) номеров не зависимо от порядка расположения номеров в столбце.
Пытливый: и если... то.... а потом так... а он ему... о она ему - ннна! и на лошадках потом тыг-дым, тыг-дым, тыг-дым
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
На листе ЖурналУчета вставлена новая кнопка, на нее повешен новый макрос. Текст макроса с комментариями - ниже (массивы, циклы, метод Find)
Скрытый текст
Код
Sub TT()
Dim arrIn, arrOut, lngI As Long, lngJ As Long
Dim wsIn As Worksheet, wsOut As Worksheet 'чисто для сокращения букв кода
Set wsIn = Worksheets("BAZA"): Set wsOut = Worksheets("ЖурналУчета")
'пишем в исходный массив данные с листа BAZA
arrIn = wsIn.Range("A1").CurrentRegion.Value
'переопределяем размерность выходного массива данных. Сколько в нем строк может получиться не знаем,
'поэтому определяем столько же, сколько в исходном. А столбцов нужно 6
ReDim arrOut(1 To UBound(arrIn, 1), 1 To 6)
'пущщаем цикл по исходному массиву, со второй строки до упора, ищем значение номер контракта на листе Журнал
For lngI = 2 To UBound(arrIn, 1)
'Если номер контракта не заполнен в базе - ругаемся и выходим
If IsEmpty(arrIn(lngI, 2)) Then
MsgBox "Не заполнен номер контракта, а надо бы!"
Exit Sub
End If
'если номера контракта нет на листе ЖурналУчета (поиск = Nothing)
If wsOut.UsedRange.Columns(2).Find(arrIn(lngI, 2)) Is Nothing Then
lngJ = lngJ + 1 'увеличиваем счетчик строк выходного массива и пишем в выходной массив данные из строки исходного массива
arrOut(lngJ, 2) = arrIn(lngI, 2): arrOut(lngJ, 3) = arrIn(lngI, 6): arrOut(lngJ, 4) = arrIn(lngI, 3)
arrOut(lngJ, 5) = arrIn(lngI, 4): arrOut(lngJ, 6) = arrIn(lngI, 5)
End If
Next lngI
With wsOut 'на листе ЖурналУчета
'находим последнюю заполненную ячейку по столбцу 1 (метод End), смещаемся на 1 ячейку вниз (Offset),
'и вставляем туда данные выходного массива
'чтобы все данные влезли, переопределяем область вставки через Resize
.Range("A3").End(xlDown).Offset(1, 0).Resize(lngJ, 6) = arrOut
'серийно заполняем номер пп в столбце А стандартным инструментом арифметическая
'прогрессия (Главная - Заполнить - прогрессия) с шагом 1
.Range("A4") = 1
.Range("A4:A" & .Range("C3").End(xlDown).Row).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
'получаем красиво пронумерованный журнал
End With
'вставлено на всякий случай, поскольку макрос можно запускать с любого листа, а на результат посмотреть надо.
'если не нужно - удалить, или закомментировать.
wsOut.Activate
Range("A3").Select
End Sub
Чего непонятно - спрашивайте.
P.S. Только заметил, что на листе ЖурналУчета - "умная таблица". Можно было сделать немного по-другому в части определения области, куда вставлять отобранные данные, но на суть процесса - не влияет.
Пытливый, спасибо огроменное! Чуть подогнал под реальную таблицу и зарррработалаааа. Если не секрет, какие изменения сделали вдогонку. Я что-то не заметил разницы в коде.
Я не делал изменений, я лишь написал, что в случае "вумной" таблицы можно определять последнюю заполненную ячейку по-другому, область для вставки определять по-другому, но это не важно, существующий вариант справляется.