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

 

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

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Макрос сравнение и копирование 2х листов в одной книге
shoma Дата: Пятница, 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 количество)

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

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


Admin:
Оформляйте коды тегами, во избежание бана!


Сообщение отредактировал shoma - Пятница, 30.08.2013, 10:09
 
Ответить
СообщениеДобрый день!, помогите новичку
в общем на лист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 ТhisWorkbook.Worksheets("Лист1").Cells(i; 1) <> wb.Worksheets("Лист1").Cells(i; 1) Then ' в столбец С пишем значение из столбца В книги 1 ТhisWorkbook.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:08
Формуляр Дата: Пятница, 30.08.2013, 10:13 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 832
Репутация: 255 ±
Замечаний: 0% ±

Excel 2003, 2013
Цитата (shoma, Пятница, 30.08.2013, 10:08 # 1 писал(а)):
Добрый день!, помогите новичку
Добрый день! Специально в помощь новичкам написаны простые короткие правила. Чтобы не тратить вустую своё и чужое время.


Excel 2003 EN, 2013 EN
 
Ответить
Сообщение
Цитата (shoma, Пятница, 30.08.2013, 10:08 # 1 писал(а)):
Добрый день!, помогите новичку
Добрый день! Специально в помощь новичкам написаны простые короткие правила. Чтобы не тратить вустую своё и чужое время.

Автор - Формуляр
Дата добавления - 30.08.2013 в 10:13
SergeyKorotun Дата: Пятница, 30.08.2013, 10:56 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007

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


PS Почему у меня при вставке из буфера русские буквы превращаются в крякозябры?
К сообщению приложен файл: compare.xlsm (16.3 Kb)


Сообщение отредактировал SergeyKorotun - Пятница, 30.08.2013, 10:59
 
Ответить
Сообщение[vba]
Public Sub Compare() Dim i As Long Dim j As Long For j = 2 To ТhisWorkbook.Worksheets("Лист2").Cells(1; 1).End(xlDown).Row        For i = 2 To ТhisWorkbook.Worksheets("Лист1").Cells(1; 1).End(xlDown).Row            If ТhisWorkbook.Worksheets("Лист1").Cells(i; 1) = ТhisWorkbook.Worksheets("Лист2").Cells(j; 1) Then                ТhisWorkbook.Worksheets("Лист1").Cells(i; 4) = ТhisWorkbook.Worksheets("Лист2").Cells(j; 4)                Exit For            End If        Next i Next j End Sub
[/vba]
PS Почему у меня при вставке из буфера русские буквы превращаются в крякозябры?

Автор - SergeyKorotun
Дата добавления - 30.08.2013 в 10:56
shoma Дата: Пятница, 30.08.2013, 12:00 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

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

Автор - shoma
Дата добавления - 30.08.2013 в 12:00
Формуляр Дата: Пятница, 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
 
Ответить
Сообщение
Цитата (shoma, Пятница, 30.08.2013, 12:00 # 5 писал(а)):
Большое спасибо, но у меня все равно не получается подогнать под свою таблицу
Удивительное дело!
Может, потратив 2 часа, прочитать уже правила и пример выложить?

Автор - Формуляр
Дата добавления - 30.08.2013 в 12:20
shoma Дата: Пятница, 30.08.2013, 12:48 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

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

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

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

Автор - shoma
Дата добавления - 30.08.2013 в 12:48
SergeyKorotun Дата: Пятница, 30.08.2013, 13:01 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
Цитата (shoma, Пятница, 30.08.2013, 12:48 # 7 писал(а)):
уже половина поудалял и все равно большой сильно

упакуйте архиватором
 
Ответить
Сообщение
Цитата (shoma, Пятница, 30.08.2013, 12:48 # 7 писал(а)):
уже половина поудалял и все равно большой сильно

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

Автор - SergeyKorotun
Дата добавления - 30.08.2013 в 13:01
shoma Дата: Пятница, 30.08.2013, 13:06 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
упаковал
К сообщению приложен файл: 0005910.rar (64.8 Kb)
 
Ответить
Сообщениеупаковал

Автор - shoma
Дата добавления - 30.08.2013 в 13:06
Формуляр Дата: Пятница, 30.08.2013, 13:34 | Сообщение № 9
Группа: Друзья
Ранг: Ветеран
Сообщений: 832
Репутация: 255 ±
Замечаний: 0% ±

Excel 2003, 2013
Цитата (shoma, Пятница, 30.08.2013, 12:48 # 7 писал(а)):
нужно с листа5, столбик H(сумм.кол) должно скопироватся в лист1, столбик F. кол-во, при совпадении кода
А зачем макрос-то понадобился?
Простейшей формулой задача решается:
= ВПР(A2; Лист5!$B:$J; 7; 0)

Другое дело, что в вашем примере нет ни одного совпадения.
К сообщению приложен файл: 8402653.rar (63.9 Kb)


Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр - Пятница, 30.08.2013, 13:36
 
Ответить
Сообщение
Цитата (shoma, Пятница, 30.08.2013, 12:48 # 7 писал(а)):
нужно с листа5, столбик H(сумм.кол) должно скопироватся в лист1, столбик F. кол-во, при совпадении кода
А зачем макрос-то понадобился?
Простейшей формулой задача решается:
= ВПР(A2; Лист5!$B:$J; 7; 0)

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

Автор - Формуляр
Дата добавления - 30.08.2013 в 13:34
SergeyKorotun Дата: Пятница, 30.08.2013, 13:43 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

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

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

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

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]
ТhisWorkbook.Worksheets("Лист5").Cells(1; 1).End(xlDown).Row
[/vba] нужно как то по другому определять, например через UsedRange

[vba]
Sub Синхронизация() Dim i As Long Dim j As Long For j = 2 To ТhisWorkbook.Worksheets("Лист5").Cells(1; 1).End(xlDown).Row      For i = 41 To ТhisWorkbook.Worksheets("Лист1").Cells(40; 1).End(xlDown).Row          If ТhisWorkbook.Worksheets("Лист1").Cells(i; 1) = ТhisWorkbook.Worksheets("Лист5").Cells(j; 1) Then              ТhisWorkbook.Worksheets("Лист1").Cells(i; 6) = ТhisWorkbook.Worksheets("Лист5").Cells(j; 8)              Exit For          End If      Next i Next j End Sub
[/vba]

Автор - SergeyKorotun
Дата добавления - 30.08.2013 в 13:43
shoma Дата: Пятница, 30.08.2013, 13:44 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

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

Автор - shoma
Дата добавления - 30.08.2013 в 13:44
shoma Дата: Пятница, 30.08.2013, 13:52 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
SergeyKorotun,

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

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

Автор - shoma
Дата добавления - 30.08.2013 в 13:52
shoma Дата: Пятница, 30.08.2013, 13:53 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
на листе1 код тоже не у все будет прописан
 
Ответить
Сообщениена листе1 код тоже не у все будет прописан

Автор - shoma
Дата добавления - 30.08.2013 в 13:53
Формуляр Дата: Пятница, 30.08.2013, 14:03 | Сообщение № 14
Группа: Друзья
Ранг: Ветеран
Сообщений: 832
Репутация: 255 ±
Замечаний: 0% ±

Excel 2003, 2013
Цитата (shoma, Пятница, 30.08.2013, 13:52 # 12 писал(а)):
авто заполнение работает ровно до пустой строчки на листе5, если заполнить все срочки то все работает, просто не у всех материалов есть код
Попорбуйте вместо 1го ст-ца

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

по 2му искать

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



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


Excel 2003 EN, 2013 EN
 
Ответить
Сообщение
Цитата (shoma, Пятница, 30.08.2013, 13:52 # 12 писал(а)):
авто заполнение работает ровно до пустой строчки на листе5, если заполнить все срочки то все работает, просто не у всех материалов есть код
Попорбуйте вместо 1го ст-ца
[vba]
For j = 2 To ТhisWorkbook.Worksheets("Лист5").Cells(1; 1).End(xlDown).Row
[/vba]по 2му искать
[vba]
For j = 2 To ТhisWorkbook.Worksheets("Лист5").Cells(1; 2).End(xlDown).Row
[/vba]

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

Автор - Формуляр
Дата добавления - 30.08.2013 в 14:03
SergeyKorotun Дата: Пятница, 30.08.2013, 14:05 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007

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


PS 14:14 немного подправил


Сообщение отредактировал SergeyKorotun - Пятница, 30.08.2013, 14:13
 
Ответить
Сообщение[vba]
Sub Синхронизация() Dim i As Long Dim j As Long For j = 2 To ТhisWorkbook.Worksheets("Лист5").Cells(65536; 1).End(xlUp).Row      For i = 41 To ТhisWorkbook.Worksheets("Лист1").UsedRange.Rows.Count 'Cells(40; 1).End(xlDown).Row          If ТhisWorkbook.Worksheets("Лист1").Cells(i; 1) <> "" And ТhisWorkbook.Worksheets("Лист1").Cells(i; 1) = ТhisWorkbook.Worksheets("Лист5").Cells(j; 1) Then              ТhisWorkbook.Worksheets("Лист1").Cells(i; 6) = ТhisWorkbook.Worksheets("Лист5").Cells(j; 8)              Exit For          End If      Next i Next j End Sub
[/vba]
PS 14:14 немного подправил

Автор - SergeyKorotun
Дата добавления - 30.08.2013 в 14:05
Формуляр Дата: Пятница, 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й и вставил. :)
Держите макрос.

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

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


Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр - Пятница, 30.08.2013, 14:10
 
Ответить
Сообщение
Цитата (Формуляр, Пятница, 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]

Автор - Формуляр
Дата добавления - 30.08.2013 в 14:09
shoma Дата: Пятница, 30.08.2013, 14:13 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

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

Автор - shoma
Дата добавления - 30.08.2013 в 14:13
SergeyKorotun Дата: Пятница, 30.08.2013, 14:15 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
Формуляр,

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

не будет правильно работать, во 2 столбце есть пустые ячейки
 
Ответить
СообщениеФормуляр, [vba]
For i = 41 To [Лист1].Cells(40, 2).End(xlDown).Row
[/vba] не будет правильно работать, во 2 столбце есть пустые ячейки

Автор - SergeyKorotun
Дата добавления - 30.08.2013 в 14:15
shoma Дата: Пятница, 30.08.2013, 14:16 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Формуляр, ага работает, спасибо!!!
 
Ответить
СообщениеФормуляр, ага работает, спасибо!!!

Автор - shoma
Дата добавления - 30.08.2013 в 14:16
SergeyKorotun Дата: Пятница, 30.08.2013, 14:18 | Сообщение № 20
Группа: Проверенные
Ранг: Обитатель
Сообщений: 301
Репутация: 15 ±
Замечаний: 0% ±

Excel 2007
Цитата (shoma, Пятница, 30.08.2013, 14:13 # 17 писал(а)):
можно узнать как сейчас работает макрос и по какому столбцу ищет?

Рабочий из сообщения 15, ищет в файле, который вы приложили по столбцам из сообщения 6
 
Ответить
Сообщение
Цитата (shoma, Пятница, 30.08.2013, 14:13 # 17 писал(а)):
можно узнать как сейчас работает макрос и по какому столбцу ищет?

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

Автор - SergeyKorotun
Дата добавления - 30.08.2013 в 14:18
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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