Здравствуйте!
Две таблицы ФИО+услуги (лист1) и база ФИО + доп информация (лист2), необходимо дополнить информацию на первом листе.
Критерий сравнения один - ФИО
Макрос выполняется ,но не так как хотелось бы. Если в последующей строке тоже самое ФИО , инфа заносится только в первую строчку, как бы перепрыгивает остальные.
Если же нет четкой последовательности в ФИО , все нормально
Наглядно проблема выглядит так:
где ХХХХ - внесенная макросом информация из листа 2
0- не внесенная информация
Иванов Усдуга 1 ХХХХХ
Иванов Услуга 2 0
Иванов Услуга 3 0
Сидоров Усдуга 1 ХХХХХ
Петров Услуга 2 ХХХХХ
Если
Sub Макрос1()
Dim sheet1 As Worksheet
Set sheet1 = ActiveWorkbook.Sheets(1)
Dim sheet2 As Worksheet
Set sheet2 = ActiveWorkbook.Sheets(2)
Dim str1 As String
Dim str2 As String
Dim i As Long
i = 3
Dim last_i As Long
last_i = 3
Dim j As Long
j = 3
Dim last_j As Long
last_j = 3
For Each Cell In sheet1.Range("A:A")
If Cell.Row > 2 Then
If Cell.Value > "" Then
last_i = Cell.Row
Else
Exit For
End If
End If
Next Cell
For Each Cell In sheet2.Range("A:A")
If Cell.Row > 2 Then
If Cell.Value > "" Then
last_j = Cell.Row
Else
Exit For
End If
End If
Next Cell
For j = 3 To last_j
str2 = sheet2.Cells(j, 3).Value
For i = 3 To last_i
str1 = sheet1.Cells(i, 3).Value
If str2 = str1 Then
sheet1.Cells(i, 9).Value = sheet2.Cells(j, 1).Value
sheet1.Cells(i, 10).Value = sheet2.Cells(j, 2).Value
sheet1.Cells(i, 11).Value = sheet2.Cells(j, 5).Value
sheet1.Cells(i, 12).Value = sheet2.Cells(j, 6).Value
sheet1.Cells(i, 13).Value = sheet2.Cells(j, 7).Value
sheet1.Cells(i, 14).Value = sheet2.Cells(j, 8).Value
sheet1.Cells(i, 15).Value = sheet2.Cells(j, 9).Value
sheet1.Cells(i, 16).Value = sheet2.Cells(j, 10).Value
Exit For
End If
Next i
Next j
End Sub
Подскажите, пожалуйста, что изменить?
За основу был взят готовый код, увы я не силен в VBA, а вручную перелопатить не представляется возможным
