Если будете копировать этот код себе в файл, то копируйте его при установленной РУССКОЙ раскладке клавиатуры, иначе вместо русских букв в модуле VBE будут нечитаемые кракозябли. Вот комментарии к коду. Этот код будет работать быстрее, чем предыдущий в файле из-за строки Application.ScreenUpdating = False
| Код |
|---|
Sub Подставить_дату_выдачи()
'объявление переменных, используемых в коде
Dim arr1CReport, Rng As Range, iRow As Long, i As Long, LastRow As Long, n As Long
Dim FIO As String, SIZ As String, SIZColumn As Long
'с листом Выгрузка из 1С делать...
With Worksheets("Выгрузка из 1С")
arr1CReport = .Range("A1").CurrentRegion.Value 'берём в массив все данные с листа Выгрузка из 1С
End With
Application.ScreenUpdating = False 'отключаем обновление экрана (для ускорения работы макроса, этого в предыдущем макросе нет)
'с листом График делать...
With Worksheets("График")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'номер последней заполненной ячейки в столбце 1 на листе График
For iRow = 3 To LastRow 'цикл с 3-й строки до последней
FIO = .Cells(iRow, 1) 'запоминаем ФИО
Do 'начало цикла
If SIZColumn <= 1 Then 'если переменная равна 0 или 1, то делать ниже
SIZColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column 'поиск последнего заполненного столбца в 1-й строке
Else 'иначе
SIZColumn = .Cells(1, SIZColumn).End(xlToLeft).Column 'поиск последнего заполненного столбца, но относительно переменной SIZColumn
End If
If SIZColumn = 1 Then Exit Do 'если номер столбца (SIZColumn) = 1, то выход из цикла (значит все СИЗ мы обработали)
SIZ = .Cells(1, SIZColumn) 'названия СИЗ из первой строки
For i = 2 To UBound(arr1CReport) 'цикл поиска ФИО в массиве данных с листа Выгрузка из 1С
If arr1CReport(i, 1) = FIO Then 'если текущая строка в массиве равна нужном нам ФИО, то
For n = i + 1 To UBound(arr1CReport) 'цикл поиска нужного СИЗ под найденным ФИО
If arr1CReport(n, 2) = "" Then Exit For 'если достигли ячейку с пустой датой, то выход (значит закончился наш ФИО)
If arr1CReport(n, 1) = SIZ Then 'если текущая строка по ФИО равна нашему названию СИЗ, то
.Cells(iRow, SIZColumn) = CDate(arr1CReport(n, 2)) 'проставляем дату на лист График из 2-го столбца массива с данными с листа Выгрузка из 1С
Exit For 'выход из цикла (дату проставили, далее цикл поиска уже не нужен)
End If
Next n
Exit For 'выходи из цикла поиска ФИО
End If
Next i
Loop Until SIZColumn = 1 'повторяем цикл DO пока не дойдём до первого столбца в первой строке, где указаны названия СИЗ
Next iRow 'следующая строка (следующий ФИО в таблице)
End With
Application.ScreenUpdating = True 'включаем обновление экрана
MsgBox "Данные по дате выдачи СИЗ подставлены!", vbInformation, "Конец"
End Sub |
