Добрый день, Уважаемые форумчане! Помогите с решением вот такой задачи Есть файл категории в нем есть два листа "Свод" и "Категории" Мне нужно чтоб макрос искал в листе "Категории" по полям и присваивал категории в соответствии с наименованием (столбца А) в листе "Свод" и вставлял информацию в столбец В категории.
Добрый день, Уважаемые форумчане! Помогите с решением вот такой задачи Есть файл категории в нем есть два листа "Свод" и "Категории" Мне нужно чтоб макрос искал в листе "Категории" по полям и присваивал категории в соответствии с наименованием (столбца А) в листе "Свод" и вставлял информацию в столбец В категории.Admnis
Public Sub www() Dim arr1 Dim arr2 Set SV = ThisWorkbook.Sheets("СВОД") Set KT = ThisWorkbook.Sheets("категории") last_row1 = SV.Cells(SV.Rows.Count, "A").End(xlUp).Row arr1 = SV.Range(SV.Cells(2, 1), SV.Cells(last_row1, 2)) last_row2 = KT.Cells(KT.Rows.Count, "A").End(xlUp).Row arr2 = KT.Range(KT.Cells(2, 1), KT.Cells(last_row2, 3)) ReDim arr3(1 To UBound(arr1), 1 To 1) For i = 1 To UBound(arr1) For j = 1 To UBound(arr2) If Replace(arr2(j, 1), """", "") = arr1(i, 1) Then arr3(i, 1) = arr2(j, 3) End If Next j Next i Sheets("СВОД").Cells(2, "B").Resize(UBound(arr1), 1) = arr3 End Sub
Пробовали так , заполняет не все ячейки в столбце категории на листе "Свод"
Public Sub www() Dim arr1 Dim arr2 Set SV = ThisWorkbook.Sheets("СВОД") Set KT = ThisWorkbook.Sheets("категории") last_row1 = SV.Cells(SV.Rows.Count, "A").End(xlUp).Row arr1 = SV.Range(SV.Cells(2, 1), SV.Cells(last_row1, 2)) last_row2 = KT.Cells(KT.Rows.Count, "A").End(xlUp).Row arr2 = KT.Range(KT.Cells(2, 1), KT.Cells(last_row2, 3)) ReDim arr3(1 To UBound(arr1), 1 To 1) For i = 1 To UBound(arr1) For j = 1 To UBound(arr2) If Replace(arr2(j, 1), """", "") = arr1(i, 1) Then arr3(i, 1) = arr2(j, 3) End If Next j Next i Sheets("СВОД").Cells(2, "B").Resize(UBound(arr1), 1) = arr3 End Sub
Пробовали так , заполняет не все ячейки в столбце категории на листе "Свод" Admnis