Есть два файла - book1 и book2. Написал простенький макрос чтобы сравнивало уникальные значения в столбцах B (обоих книг) и при нахождении совпадения подставляло значения из 3-го столбца book2 в третий столбец book1. Книжки в одной папке. Макрос в модуле первой книги
[vba]
Код
Sub compare() Dim compareRange As Variant, compareRange1 As Variant, x As Variant, y As Variant
Set compareRange = Sheets("sheet1").Range("B2:B6") Set compareRange1 = Workbooks("book2.xls").Sheets("sheet1").Range("B2:B6")
For Each x In compareRange For Each y In compareRange1
If x = y Then x.Offset(0, 1) = y.Offset(0, 1)
Next y Next x
End Sub
[/vba]
Забыл добавить - ничего не происходит при выполнении макроса.
Добрый день.
Есть два файла - book1 и book2. Написал простенький макрос чтобы сравнивало уникальные значения в столбцах B (обоих книг) и при нахождении совпадения подставляло значения из 3-го столбца book2 в третий столбец book1. Книжки в одной папке. Макрос в модуле первой книги
[vba]
Код
Sub compare() Dim compareRange As Variant, compareRange1 As Variant, x As Variant, y As Variant
Set compareRange = Sheets("sheet1").Range("B2:B6") Set compareRange1 = Workbooks("book2.xls").Sheets("sheet1").Range("B2:B6")
For Each x In compareRange For Each y In compareRange1
If x = y Then x.Offset(0, 1) = y.Offset(0, 1)
Next y Next x
End Sub
[/vba]
Забыл добавить - ничего не происходит при выполнении макроса.Treider01
К дару телепатии у меня добавился дар провидения, поэтому свою ошибку нашёл до.
Всёравно спасибо.
UPD. К сожалению оба дара в очередной раз не работают. Хотя может я где то ошибся по незнанию.
[vba]
Код
Sub compare() Dim compareRange As Variant, compareRange1 As Variant, x As Variant, y As Variant, j As Long
With Workbooks("book2.xls").Sheets("sheet1")
j = .Cells(.Rows.Count, "b").End(xlUp).Row
Set compareRange1 = Range(Cells(2, "b"), Cells(j, "b"))
For Each x In compareRange1 x = Split(WorksheetFunction.Trim(x), " ") Next x
End With
With Sheets("sheet1")
Set compareRange = Sheets("sheet1").Range("B2:B100")
For Each y In compareRange For Each x In compareRange1
If y = x Then y.Offset(0, 1) = x.Offset(0, 1)
Next x Next y End With
End Sub
[/vba]
Не работает. Работал когда выгружал значения масивов в соседнюю ячейку, делал из них новый масив и сравнивал со вторым. Но потом подумал что оно мне не надо, т.к. работал долго и странно.
К дару телепатии у меня добавился дар провидения, поэтому свою ошибку нашёл до.
Всёравно спасибо.
UPD. К сожалению оба дара в очередной раз не работают. Хотя может я где то ошибся по незнанию.
[vba]
Код
Sub compare() Dim compareRange As Variant, compareRange1 As Variant, x As Variant, y As Variant, j As Long
With Workbooks("book2.xls").Sheets("sheet1")
j = .Cells(.Rows.Count, "b").End(xlUp).Row
Set compareRange1 = Range(Cells(2, "b"), Cells(j, "b"))
For Each x In compareRange1 x = Split(WorksheetFunction.Trim(x), " ") Next x
End With
With Sheets("sheet1")
Set compareRange = Sheets("sheet1").Range("B2:B100")
For Each y In compareRange For Each x In compareRange1
If y = x Then y.Offset(0, 1) = x.Offset(0, 1)
Next x Next y End With
End Sub
[/vba]
Не работает. Работал когда выгружал значения масивов в соседнюю ячейку, делал из них новый масив и сравнивал со вторым. Но потом подумал что оно мне не надо, т.к. работал долго и странно.
Так же хотелось бы ускорить работу макроса.Treider01
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
