Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сравнение двух столбцов и замена значений - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сравнение двух столбцов и замена значений (Макросы/Sub)
Сравнение двух столбцов и замена значений
Артур Дата: Среда, 25.05.2016, 13:17 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Ребят подскажите пожалуйста! Есть две книги "Книга1" и "Книга2". Необходимо сравнить столбец "серийный №" в двух книгах и при совпадении записать значение "Книга2" столбец "Место нахождение" в "Книга1" столбец "Место нахождение" т.е проще говоря сменить адреса место нахождение принтеров на новые)) список очень большой поэтому искать принтер по серийному номеру и прописывать новый адрес очень нудно) Можно ли это сделать с помощью макроса или кнопки?
[moder]Закрыто. Дублирование[/moder]
К сообщению приложен файл: 3761549.xlsx(11Kb) · 3586807.xlsx(12Kb)


Сообщение отредактировал Pelena - Среда, 25.05.2016, 17:49
 
Ответить
СообщениеРебят подскажите пожалуйста! Есть две книги "Книга1" и "Книга2". Необходимо сравнить столбец "серийный №" в двух книгах и при совпадении записать значение "Книга2" столбец "Место нахождение" в "Книга1" столбец "Место нахождение" т.е проще говоря сменить адреса место нахождение принтеров на новые)) список очень большой поэтому искать принтер по серийному номеру и прописывать новый адрес очень нудно) Можно ли это сделать с помощью макроса или кнопки?
[moder]Закрыто. Дублирование[/moder]

Автор - Артур
Дата добавления - 25.05.2016 в 13:17
Udik Дата: Среда, 25.05.2016, 15:22 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1219
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
Можно что-то типа такого
[vba]
Код

Public Sub channge()
    Dim w1 As Workbook
    Dim w2 As Workbook
    Dim lastnum1 As Integer, lastnum2%, i%, j%    
    Set w1 = ActiveWorkbook
    fileToOpen = Application.GetOpenFilename("All Files (*.*),*.*")
    If fileToOpen = False Then Exit Sub
    Workbooks.Open (fileToOpen)
    Set w2 = ActiveWorkbook
    lastnum1 = w1.Sheets("Лист1").Range("A1").SpecialCells(xlLastCell).Row
    lastnum2 = w2.Sheets("Лист1").Range("A1").SpecialCells(xlLastCell).Row
    For i = 3 To lastnum1
        For j = 3 To lastnum1
            If w1.Sheets("Лист1").Cells(i, 3) = w2.Sheets("Лист1").Cells(j, 3) Then
                w1.Sheets("Лист1").Cells(i, 5) = w2.Sheets("Лист1").Cells(j, 5)
                Exit For
            End If
        Next j
    Next i
    w2.Close
End Sub

[/vba]
К сообщению приложен файл: 0t.xlsm(18Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Среда, 25.05.2016, 15:26
 
Ответить
СообщениеМожно что-то типа такого
[vba]
Код

Public Sub channge()
    Dim w1 As Workbook
    Dim w2 As Workbook
    Dim lastnum1 As Integer, lastnum2%, i%, j%    
    Set w1 = ActiveWorkbook
    fileToOpen = Application.GetOpenFilename("All Files (*.*),*.*")
    If fileToOpen = False Then Exit Sub
    Workbooks.Open (fileToOpen)
    Set w2 = ActiveWorkbook
    lastnum1 = w1.Sheets("Лист1").Range("A1").SpecialCells(xlLastCell).Row
    lastnum2 = w2.Sheets("Лист1").Range("A1").SpecialCells(xlLastCell).Row
    For i = 3 To lastnum1
        For j = 3 To lastnum1
            If w1.Sheets("Лист1").Cells(i, 3) = w2.Sheets("Лист1").Cells(j, 3) Then
                w1.Sheets("Лист1").Cells(i, 5) = w2.Sheets("Лист1").Cells(j, 5)
                Exit For
            End If
        Next j
    Next i
    w2.Close
End Sub

[/vba]

Автор - Udik
Дата добавления - 25.05.2016 в 15:22
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сравнение двух столбцов и замена значений (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!