Макрос сравнение и копирование 2х листов в одной книге - Мир MS Excel

Регистрация

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

= Мир MS Excel/Макрос сравнение и копирование 2х листов в одной книге - Мир MS Excel

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_, DrMini

Макрос сравнение и копирование 2х листов в одной книге (Макросы Sub)

Макрос сравнение и копирование 2х листов в одной книге

Дата: Пятница, 30.08.2013, 10:08 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

Добрый день!, помогите новичку
в общем на лист1 есть типо прайса, колонка A-артикул, B-наименование, D-количество. Вставляю на лист2 другую таблицу, где A-артикул, B-наименование, D-количество. нужно чтоб exel сканировал лист1(столбец A) и лист2(столбец A) и при совподении артикулов нужно чтоб он копировал из листа2(столбец D количество) в лист1 (столбец D количество)

в поиске нашел токо вот такой макрос но не как не могу добится работоспособности.

[vba]

Код

Public Sub Compare()
Dim i As Integer
Dim wb As Excel.Workbook

Set wb = Excel.Workbooks("Книга1") 'получаем экземпляр книги с которой нужно сравнивать

'проверить 100 строк
For i = 1 To 100
If ThisWorkbook.Worksheets("Лист1").Cells(i, 1) <> wb.Worksheets("Лист1").Cells(i, 1) Then
' в столбец С пишем значение из столбца В книги 1
ThisWorkbook.Worksheets("Лист1").Cells(i, 3) = wb.Worksheets("Лист1").Cells(i, 2)
End If
Next i
End Sub

[/vba]
[admin]Оформляйте коды тегами, во избежание бана![/admin]

Сообщение отредактировал shoma - Пятница, 30.08.2013, 10:09

Ответить

Формуляр

Дата: Пятница, 30.08.2013, 10:13 | Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Цитата (shoma, Пятница, 30.08.2013, 10:08 # 1)

Добрый день!, помогите новичку

Добрый день! Специально в помощь новичкам написаны простые короткие правила. Чтобы не тратить вустую своё и чужое время.

Excel 2003 EN, 2013 EN

Ответить

Дата: Пятница, 30.08.2013, 10:56 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

[vba]

Код

Public Sub Compare()
Dim i As Long
Dim j As Long

For j = 2 To ThisWorkbook.Worksheets("Лист2").Cells(1, 1).End(xlDown).Row
       For i = 2 To ThisWorkbook.Worksheets("Лист1").Cells(1, 1).End(xlDown).Row
           If ThisWorkbook.Worksheets("Лист1").Cells(i, 1) = ThisWorkbook.Worksheets("Лист2").Cells(j, 1) Then
               ThisWorkbook.Worksheets("Лист1").Cells(i, 4) = ThisWorkbook.Worksheets("Лист2").Cells(j, 4)
               Exit For
           End If
       Next i
Next j
End Sub

[/vba]
PS Почему у меня при вставке из буфера русские буквы превращаются в крякозябры?

К сообщению приложен файл: compare.xlsm (16.3 Kb)

Сообщение отредактировал SergeyKorotun - Пятница, 30.08.2013, 10:59

Ответить

Дата: Пятница, 30.08.2013, 12:00 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

SergeyKorotun,
Большое спасибо, но у меня все равно не получается подогнать под свою таблицу

Ответить

Формуляр

Дата: Пятница, 30.08.2013, 12:20 | Сообщение № 5

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Цитата (shoma, Пятница, 30.08.2013, 12:00 # 5)

Большое спасибо, но у меня все равно не получается подогнать под свою таблицу

Удивительное дело!
Может, потратив 2 часа, прочитать уже правила и пример выложить?

Excel 2003 EN, 2013 EN

Ответить

Дата: Пятница, 30.08.2013, 12:48 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

Формуляр, чтож такие злые)), читал я правила и поиском пользовался.

нужно с листа5, столбик H(сумм.кол) должно скопироватся в лист1, столбик F. кол-во, при совпадении кода, файл перевел в 2003г но все равно выложить не могу он превышает 200кб, уже половина поудалял и все равно большой сильно

Ответить

Дата: Пятница, 30.08.2013, 13:01 | Сообщение № 7

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

Цитата (shoma, Пятница, 30.08.2013, 12:48 # 7)

уже половина поудалял и все равно большой сильно

упакуйте архиватором

Ответить

Дата: Пятница, 30.08.2013, 13:06 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

упаковал

К сообщению приложен файл: 0005910.rar (64.8 Kb)

Ответить

Формуляр

Дата: Пятница, 30.08.2013, 13:34 | Сообщение № 9

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Цитата (shoma, Пятница, 30.08.2013, 12:48 # 7)

нужно с листа5, столбик H(сумм.кол) должно скопироватся в лист1, столбик F. кол-во, при совпадении кода

А зачем макрос-то понадобился?
Простейшей формулой задача решается:

Код

= VLOOKUP(A2, Лист5!$B:$J, 7, 0)

Другое дело, что в вашем примере нет ни одного совпадения.

К сообщению приложен файл: 8402653.rar (63.9 Kb)

Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр - Пятница, 30.08.2013, 13:36

Ответить

Дата: Пятница, 30.08.2013, 13:43 | Сообщение № 10

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

Уже само наименование столбца "Код" подразумевает заполнение его уникальными значениями, а у вас есть пустые ячейки.
Сначала заполните их значениями а потом запускайте макрос.
Если все же в коде могут присутствовать пустые значения, то определение конечных ячеек [vba]

Код

ThisWorkbook.Worksheets("Лист5").Cells(1, 1).End(xlDown).Row

[/vba] нужно как то по другому определять, например через UsedRange

[vba]

Код

Sub Синхронизация()
Dim i As Long
Dim j As Long

For j = 2 To ThisWorkbook.Worksheets("Лист5").Cells(1, 1).End(xlDown).Row
     For i = 41 To ThisWorkbook.Worksheets("Лист1").Cells(40, 1).End(xlDown).Row
         If ThisWorkbook.Worksheets("Лист1").Cells(i, 1) = ThisWorkbook.Worksheets("Лист5").Cells(j, 1) Then
             ThisWorkbook.Worksheets("Лист1").Cells(i, 6) = ThisWorkbook.Worksheets("Лист5").Cells(j, 8)
             Exit For
         End If
     Next i
Next j
End Sub

[/vba]

Ответить

Дата: Пятница, 30.08.2013, 13:44 | Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

Формуляр,
в ячейке с количеством не должно быть формул, поэтому и хочу сделать через макрос, совпадения есть точно 3 штуки(я их специально делал). Это я только начинаю ее доводить до ума поэтому пока вводом артикулов не занимался. На листе5 туда выгружеться эта спецификация из другой программы, и то что не заполнилось на листе1 будет заполнятся в ручную. Это еще эспирементальный файл

Ответить

Дата: Пятница, 30.08.2013, 13:52 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

SergeyKorotun,

вот с этим макросом авто заполнение работает ровно до пустой строчки на листе5, если заполнить все срочки то все работает, просто не у всех материалов есть код, это можно как нибудь обойти?

Ответить

Дата: Пятница, 30.08.2013, 13:53 | Сообщение № 13

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

на листе1 код тоже не у все будет прописан

Ответить

Формуляр

Дата: Пятница, 30.08.2013, 14:03 | Сообщение № 14

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Цитата (shoma, Пятница, 30.08.2013, 13:52 # 12)

авто заполнение работает ровно до пустой строчки на листе5, если заполнить все срочки то все работает, просто не у всех материалов есть код

Попорбуйте вместо 1го ст-ца
[vba]

Код

For j = 2 To ThisWorkbook.Worksheets("Лист5").Cells(1, 1).End(xlDown).Row

[/vba]по 2му искать
[vba]

Код

For j = 2 To ThisWorkbook.Worksheets("Лист5").Cells(1, 2).End(xlDown).Row

[/vba]

И на Лист1 тоже.

Excel 2003 EN, 2013 EN

Ответить

Дата: Пятница, 30.08.2013, 14:05 | Сообщение № 15

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

[vba]

Код

Sub Синхронизация()
Dim i As Long
Dim j As Long

For j = 2 To ThisWorkbook.Worksheets("Лист5").Cells(65536, 1).End(xlUp).Row
     For i = 41 To ThisWorkbook.Worksheets("Лист1").UsedRange.Rows.Count 'Cells(40, 1).End(xlDown).Row
         If ThisWorkbook.Worksheets("Лист1").Cells(i, 1) <> "" And ThisWorkbook.Worksheets("Лист1").Cells(i, 1) = ThisWorkbook.Worksheets("Лист5").Cells(j, 1) Then
             ThisWorkbook.Worksheets("Лист1").Cells(i, 6) = ThisWorkbook.Worksheets("Лист5").Cells(j, 8)
             Exit For
         End If
     Next i
Next j
End Sub

[/vba]
PS 14:14 немного подправил

Сообщение отредактировал SergeyKorotun - Пятница, 30.08.2013, 14:13

Ответить

Формуляр

Дата: Пятница, 30.08.2013, 14:09 | Сообщение № 16

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Цитата (Формуляр, Пятница, 30.08.2013, 13:34 # 9)

Другое дело, что в вашем примере нет ни одного совпадения.

Цитата (shoma, Пятница, 30.08.2013, 13:44 # 11)

совпадения есть точно 3 штуки(я их специально делал)

Действительно есть. Только вы не указали, с какой строчки список начинается (вернее, указали, что с 1ой). Я с 1й и вставил.

Держите макрос.
[vba]

Код

Sub Синхронизация()
Dim i As Long
Dim j As Long

For j = 2 To [Лист5].Cells(1, 2).End(xlDown).Row
      For i = 41 To [Лист1].Cells(40, 2).End(xlDown).Row
          If [Лист1].Cells(i, 1) = [Лист5].Cells(j, 1) Then
              [Лист1].Cells(i, 6) = [Лист5].Cells(j, 8)
              Exit For
          End If
      Next i
Next j
End Sub

[/vba]

К сообщению приложен файл: 8769874.rar (64.0 Kb)

Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр - Пятница, 30.08.2013, 14:10

Ответить

Дата: Пятница, 30.08.2013, 14:13 | Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

SergeyKorotun,
работает! Огромное спасибо!!! что потратили на меня время, если не сложно можно узнать как сейчас работает макрос и по какому столбцу ищет?

Ответить

Дата: Пятница, 30.08.2013, 14:15 | Сообщение № 18

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

Формуляр, [vba]

Код

For i = 41 To [Лист1].Cells(40, 2).End(xlDown).Row

[/vba] не будет правильно работать, во 2 столбце есть пустые ячейки

Ответить

Дата: Пятница, 30.08.2013, 14:16 | Сообщение № 19

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 20% ±

Excel 2007

Формуляр, ага работает, спасибо!!!

Ответить

Дата: Пятница, 30.08.2013, 14:18 | Сообщение № 20

Группа: Проверенные

Ранг: Обитатель

Сообщений: 301

Репутация: 15 ±

Замечаний: 0% ±

Excel 2007

Цитата (shoma, Пятница, 30.08.2013, 14:13 # 17)

можно узнать как сейчас работает макрос и по какому столбцу ищет?

Рабочий из сообщения 15, ищет в файле, который вы приложили по столбцам из сообщения 6

Ответить

Макрос сравнение и копирование 2х листов в одной книге (Макросы Sub)

Страница 1 из 2
1
2
»

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