Есть два листа, которые оба связаны через стобцы табельного номера. Есть макрос, по нажатию на кнопку -если табельный номер листа1 совпал с табномером листа2, то присваивает значение в ячейку листа1...но почему то , некоторые ячейки остаются пустыми хотя табельный этот есть и ва листе1 и в листе2. Тип данных ячейки совпадает..может что в коде не так?
Код
Sub ЗаполняемПрофессияИДолжность()
AllRecs = Application.WorksheetFunction.CountA(Sheets("выходная форма 2 ").Range("C:C"))
cAllRecs = Application.WorksheetFunction.CountA(Sheets("оперзапрос на 19.07.22").Range("A:A"))
For CurRec = 2 To cAllRecs
AllCrit = Sheets("оперзапрос на 19.07.22").Cells(CurRec, 1)
For cRecs = 10 To AllRecs
CheckKrit = Sheets("выходная форма 2 ").Cells(cRecs, 3)
If CheckKrit = AllCrit Then
Sheets("выходная форма 2 ").Cells(cRecs, 4) = Sheets("оперзапрос на 19.07.22").Cells(CurRec, 5)
Sheets("выходная форма 2 ").Cells(cRecs, 5) = Sheets("оперзапрос на 19.07.22").Cells(CurRec, 3)
End If
Next cRecs
Next CurRec
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Код в отдельном модуле. Листам заданы кодовые имена в редакторе
Код
'Option Base 1
Option Explicit
'Option Private Module
'==================================================================================================
Sub ЗаполняемПрофессияИДолжность()
Dim dic As New Dictionary
Dim aOper, aForm, tx$, r&, f&, n&
r = shOper.Cells(shOper.Rows.Count, 1).End(xlUp).Row
If r > 1 Then aOper = shOper.Range("A2:G" & r) Else MsgBox "Оперзапросов нет!", vbCritical, "ПУСТО": Exit Sub
For r = 1 To UBound(aOper, 1)
If Len(aOper(r, 1)) Then dic(CStr(aOper(r, 1))) = r
Next r
r = shForm.Cells(shForm.Rows.Count, 3).End(xlUp).Row
If r > 9 Then aForm = shForm.Range("A10:G" & r) Else MsgBox "Форма пустая!", vbCritical, "ПУСТО": Exit Sub
For r = 1 To UBound(aForm, 1)
If Len(aForm(r, 3)) = 0 Then GoTo nx Else tx = aForm(r, 3)
If Not dic.Exists(tx) Then GoTo nx
n = n + 1: f = dic(tx)
aForm(r, 4) = aOper(f, 5)
aForm(r, 5) = aOper(f, 3)
nx:
Next r
If n = 0 Then MsgBox "Ничего ненайдено", vbInformation, "ПУСТО": Exit Sub
shForm.Range("A10").Resize(UBound(aForm, 1), UBound(aForm, 2)).Value2 = aForm
MsgBox "Найдено записей: " & Format$(n, "#,##0"), vbInformation, "Заполнение закончилось!"
End Sub
Удалите автора из свойств, если не хотите разглашать (я удалил в этом файле).
Изменено: Jack Famous - 31.08.2022 16:12:57(Забыл про вывод на лист))))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
при исходных данных, которые Вы приложили, Ваш скрипт вообще нерабочий, т.к. даже первая строка с данными(на обоих листах) расположена гораздо ниже, чем определено Вашим кодом. Но даже если исправить этот момент - у меня все находится без проблем в приложенном файле. Обе строки из обоих листов идентичны. Код я изменил следующим образом:
Код
Sub ЗаполняемПрофессияИДолжность()
With Sheets("выходная форма 2 ")
AllRecs = .Cells(.Rows.Count, 3).End(xlUp).Row
End With
With Sheets("оперзапрос на 19.07.22")
cAllRecs = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For CurRec = 2 To cAllRecs
AllCrit = WorksheetFunction.Trim(Sheets("оперзапрос на 19.07.22").Cells(CurRec, 1))
If Len(AllCrit) Then
For cRecs = 10 To AllRecs
CheckKrit = WorksheetFunction.Trim(Sheets("выходная форма 2 ").Cells(cRecs, 3))
If Len(CheckKrit) Then
If CheckKrit = WorksheetFunction.Trim(AllCrit) Then
Sheets("выходная форма 2 ").Cells(cRecs, 4) = Sheets("оперзапрос на 19.07.22").Cells(CurRec, 5)
Sheets("выходная форма 2 ").Cells(cRecs, 5) = Sheets("оперзапрос на 19.07.22").Cells(CurRec, 3)
End If
End If
Next cRecs
End If
Next CurRec
MsgBox ("Заполнение закончилось!")
End Sub
это не оптимально ни по скорости, ни по части выполнения, ни по части написания кода вообще. Но старался внести минимум правок, чтобы у Вас хоть какое-то понимание возникло. .Cells(.Rows.Count, 3).End(xlUp).Row - это определение последней заполненной строки в конкретном столбце. При этом даже если в этом столбце будут внутри пустые ячейки - последняя будет определена корректно. Если, конечно, нижние строки не скрыты фильтром или через меню. Подробнее: Как определить последнюю ячейку на листе через VBA?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...