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

Старая форма входа

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

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

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

shoma

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

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

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

Сообщений: 19

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

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

Excel 2007

SergeyKorotun,
а можно немного понаглеть и попользоватся добротой)

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

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

Ответить

shoma

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

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

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

Сообщений: 19

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

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

Excel 2007

вот нашел макрос но пока не могу сообразить как его переделать под свои нужды, макросами я начал интересоватся только вчера поэтому не обесудте, то этого даже не знал что это такое и как запускать

[vba]

Код

Sub DelDups_TwoListsDict()
Dim iLastrow As Long
Dim i As Long ', x&
' Dim tm
' tm = Timer

' Для ускорения работы макроса обновление экрана отключается.
Application.ScreenUpdating = False

iLastrow = Sheets("1").Cells(Rows.Count, 2).End(xlUp).Row
a = Range(Sheets("1").Cells(1, 1), Sheets("1").Cells(iLastrow, 1)).Value

With CreateObject("Scripting.Dictionary")
' .CompareMode = 1
For i = 1 To UBound(a)
.Item(a(i, 1)) = vbNullString
Next

iLastrow = Sheets("2").Cells(Rows.Count, 1).End(xlUp).Row
a = Range(Sheets("2").Cells(1, 1), Sheets("2").Cells(iLastrow, 1)).Value

For i = UBound(a) To 2 Step -1
If .exists(a(i, 1)) Then
' x = x + 1
' str_ = str_ & a(i, 1) & "/"
Sheets("2").Rows(i).EntireRow.Delete
End If
Next i
End With

Application.ScreenUpdating = True
' Debug.Print Timer - tm
' MsgBox str_ & vbNewLine & x

End Sub

[/vba]

Ответить

SergeyKorotun

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

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

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

Сообщений: 301

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

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

Excel 2007

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

сделать чтоб после этого всего он бы отметил на листе5 позиции которые не совпали

на Листе 5 коды, которые есть на Листе 1, выделятся зеленым цветом.
[vba]

Код

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

ThisWorkbook.Worksheets("Лист5").Range(ThisWorkbook.Worksheets("Лист5").Cells(1, 1), _
              ThisWorkbook.Worksheets("Лист5").Cells(ThisWorkbook.Worksheets("Лист5").Cells(65536, 1).End(xlUp).Row, 1)).Select
SelectColorDelete
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)
             ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
             SelectColorSet
             Exit For
         End If
     Next i
Next j
End Sub
Sub SelectColorDelete()
     With Selection.Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Sub SelectColorSet()

     With Selection.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .Color = 5296274
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

[/vba]

Ответить

shoma

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

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

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

Сообщений: 19

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

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

Excel 2007

SergeyKorotun,
ошибка
Run-time error "1004"
метод select из класса range завершен невнрно

Ответить

SergeyKorotun

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

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

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

Сообщений: 301

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

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

Excel 2007

[vba]

Код

Sub Синхронизация()
     Dim i As Long
     Dim j As Long
     Application.ScreenUpdating = False
     ThisWorkbook.Worksheets("Лист5").Activate
     ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(ActiveSheet.Cells(65536, 1).End(xlUp).Row, 1)).Select
     SelectColorDelete

     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)
                 ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
                 SelectColorSet
                 Exit For
             End If
         Next i
     Next j
     ThisWorkbook.Worksheets("Лист1").Activate
     Application.ScreenUpdating = True
End Sub
Private Sub SelectColorDelete()
     With Selection.Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Private Sub SelectColorSet()

     With Selection.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .Color = 5296274
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

[/vba]

Ответить

shoma

Дата: Суббота, 31.08.2013, 11:09 | Сообщение № 26

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

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

Сообщений: 19

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

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

Excel 2007

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

Ответить

SergeyKorotun

Дата: Воскресенье, 01.09.2013, 17:56 | Сообщение № 27

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

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

Сообщений: 301

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

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

Excel 2007

Ни Лист5 удаляет строки, коды которых есть на Лист1
Если удаление надо производить не одновременно с подстановкой количества на Лист1, то в [vba]

Код

Sub Синхронизация()

[/vba] закоментируй (апостроф спереди команды) или удали строку [vba]

Код

DelGreenRows

[/vba], а в [vba]

Код

Private Sub DelGreenRows()

[/vba] удали [vba]

Код

Private

[/vba]
[vba]

Код

Sub Синхронизация()
     Dim i As Long
     Dim j As Long
     Application.ScreenUpdating = False
     ThisWorkbook.Worksheets("Лист5").Activate
     ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(ActiveSheet.Cells(65536, 1).End(xlUp).Row, 1)).Select
     SelectColorDelete

     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)
                 ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
                 SelectColorSet
                 Exit For
             End If
         Next i
     Next j
     ThisWorkbook.Worksheets("Лист1").Activate
     DelGreenRows
     Application.ScreenUpdating = True
End Sub

Private Sub SelectColorDelete()
     With Selection.Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Private Sub SelectColorSet()

     With Selection.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .Color = 5296274
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Private Sub DelGreenRows()
     Application.ScreenUpdating = False
     ThisWorkbook.Worksheets("Лист5").Activate

     For j = ThisWorkbook.Worksheets("Лист5").Cells(65536, 1).End(xlUp).Row To 2 Step -1
         ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
         If ActiveCell.Interior.Color = 5296274 Then
            Rows(j & ":" & j).Select
            Selection.Delete Shift:=xlUp
         End If
     Next j
     ThisWorkbook.Worksheets("Лист1").Activate
     Application.ScreenUpdating = True
End Sub

[/vba]

Код

Sub Синхронизация()

[/vba] закоментируй (апостроф спереди команды) или удали строку [vba]

Код

DelGreenRows

[/vba], а в [vba]

Код

Private Sub DelGreenRows()

[/vba] удали [vba]

Код

Private

[/vba]
[vba]

Код

Sub Синхронизация()
     Dim i As Long
     Dim j As Long
     Application.ScreenUpdating = False
     ThisWorkbook.Worksheets("Лист5").Activate
     ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(ActiveSheet.Cells(65536, 1).End(xlUp).Row, 1)).Select
     SelectColorDelete

     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)
                 ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
                 SelectColorSet
                 Exit For
             End If
         Next i
     Next j
     ThisWorkbook.Worksheets("Лист1").Activate
     DelGreenRows
     Application.ScreenUpdating = True
End Sub

Private Sub SelectColorDelete()
     With Selection.Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Private Sub SelectColorSet()

     With Selection.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .Color = 5296274
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Private Sub DelGreenRows()
     Application.ScreenUpdating = False
     ThisWorkbook.Worksheets("Лист5").Activate

     For j = ThisWorkbook.Worksheets("Лист5").Cells(65536, 1).End(xlUp).Row To 2 Step -1
         ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
         If ActiveCell.Interior.Color = 5296274 Then
            Rows(j & ":" & j).Select
            Selection.Delete Shift:=xlUp
         End If
     Next j
     ThisWorkbook.Worksheets("Лист1").Activate
     Application.ScreenUpdating = True
End Sub

[/vba]SergeyKorotun

Ответить

СообщениеНи Лист5 удаляет строки, коды которых есть на Лист1
Если удаление надо производить не одновременно с подстановкой количества на Лист1, то в [vba]

Код

Sub Синхронизация()

[/vba] закоментируй (апостроф спереди команды) или удали строку [vba]

Код

DelGreenRows

[/vba], а в [vba]

Код

Private Sub DelGreenRows()

[/vba] удали [vba]

Код

Private

[/vba]
[vba]

Код

Sub Синхронизация()
     Dim i As Long
     Dim j As Long
     Application.ScreenUpdating = False
     ThisWorkbook.Worksheets("Лист5").Activate
     ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(ActiveSheet.Cells(65536, 1).End(xlUp).Row, 1)).Select
     SelectColorDelete

     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)
                 ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
                 SelectColorSet
                 Exit For
             End If
         Next i
     Next j
     ThisWorkbook.Worksheets("Лист1").Activate
     DelGreenRows
     Application.ScreenUpdating = True
End Sub

Private Sub SelectColorDelete()
     With Selection.Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Private Sub SelectColorSet()

     With Selection.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .Color = 5296274
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With
End Sub

Private Sub DelGreenRows()
     Application.ScreenUpdating = False
     ThisWorkbook.Worksheets("Лист5").Activate

     For j = ThisWorkbook.Worksheets("Лист5").Cells(65536, 1).End(xlUp).Row To 2 Step -1
         ThisWorkbook.Worksheets("Лист5").Cells(j, 1).Select
         If ActiveCell.Interior.Color = 5296274 Then
            Rows(j & ":" & j).Select
            Selection.Delete Shift:=xlUp
         End If
     Next j
     ThisWorkbook.Worksheets("Лист1").Activate
     Application.ScreenUpdating = True
End Sub

[/vba]

Автор - SergeyKorotun
Дата добавления - 01.09.2013 в 17:56

shoma

Дата: Вторник, 03.09.2013, 21:48 | Сообщение № 28

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

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

Сообщений: 19

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

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

Excel 2007

не могу понять одну строчку
[vba]

Код

For i = 41 To ThisWorkbook.Worksheets("Лист1").UsedRange.Rows.Count 'Cells(40, 1).End(xlDown).Row

[/vba]

а конкретно Cells(40, 1)
клетка 40 столбец A . какую функцию выполняет?

Ответить

ShAM

Дата: Среда, 04.09.2013, 00:23 | Сообщение № 29

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

Ранг: Старожил

Сообщений: 1347

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

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

Excel 2010

Цитата (shoma, Вторник, 03.09.2013, 21:48 # 28)

а конкретно Cells(40, 1)
клетка 40 столбец A . какую функцию выполняет?

В данном случае никакую, она же закомментирована. Все, что в строке идет после ' (одиночная кавычка) VBA воспринимает, как комментарий и на выполнение процедуры эта часть никак не влияет.
ЗЫ: Видимо, осталось с предыдущей версии (на всякий случай, вдруг придется вернуться).

Ответить

shoma

Дата: Воскресенье, 08.09.2013, 20:27 | Сообщение № 30

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

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

Сообщений: 19

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

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

Excel 2007

подскажите еще: как запустить макрос чтоб сравнивал разные столбцы?
пример вот рабочий макрос:
[vba]

Код

Sub Простановкакода()
Dim i As Long
Dim j As Long

For j = 2 To ThisWorkbook.Worksheets("Материалы").Cells(65536, 1).End(xlUp).Row
For i = 41 To ThisWorkbook.Worksheets("Общая").UsedRange.Rows.Count 'Cells(40, 1).End(xlDown).Row
If ThisWorkbook.Worksheets("Общая").Cells(i, 7) <> "" And ThisWorkbook.Worksheets("Общая").Cells(i, 7) = ThisWorkbook.Worksheets("Материалы").Cells(j, 1) Then
ThisWorkbook.Worksheets("Общая").Cells(i, 14) = ThisWorkbook.Worksheets("Материалы").Cells(j, 2)
Exit For
End If
Next i
Next j
End Sub

мне нужно чтоб в этом же макросе сравнивались еще и другие столбцы, тоисть вот так:
For j = 2 To ThisWorkbook.Worksheets("Материалы").Cells(65536, 1).End(xlUp).Row
For i = 41 To ThisWorkbook.Worksheets("Общая").UsedRange.Rows.Count 'Cells(40, 1).End(xlDown).Row
If ThisWorkbook.Worksheets("Общая").Cells(i, 7) <> "" And ThisWorkbook.Worksheets("Общая").Cells(i, 7) = ThisWorkbook.Worksheets("Материалы").Cells(j, 5) Then
ThisWorkbook.Worksheets("Общая").Cells(i, 14) = ThisWorkbook.Worksheets("Материалы").Cells(j, 6)

добавляю это в первый макрос но неработает. как правильно его добавить?
Sub Простановкакода()
Dim i As Long
Dim j As Long

For j = 2 To ThisWorkbook.Worksheets("Материалы").Cells(65536, 1).End(xlUp).Row
For i = 41 To ThisWorkbook.Worksheets("Общая").UsedRange.Rows.Count 'Cells(40, 1).End(xlDown).Row
If ThisWorkbook.Worksheets("Общая").Cells(i, 7) <> "" And ThisWorkbook.Worksheets("Общая").Cells(i, 7) = ThisWorkbook.Worksheets("Материалы").Cells(j, 1) Then
ThisWorkbook.Worksheets("Общая").Cells(i, 14) = ThisWorkbook.Worksheets("Материалы").Cells(j, 2)

For j = 2 To ThisWorkbook.Worksheets("Материалы").Cells(65536, 1).End(xlUp).Row
For i = 41 To ThisWorkbook.Worksheets("Общая").UsedRange.Rows.Count 'Cells(40, 1).End(xlDown).Row
If ThisWorkbook.Worksheets("Общая").Cells(i, 7) <> "" And ThisWorkbook.Worksheets("Общая").Cells(i, 7) = ThisWorkbook.Worksheets("Материалы").Cells(j, 5) Then
ThisWorkbook.Worksheets("Общая").Cells(i, 14) = ThisWorkbook.Worksheets("Материалы").Cells(j, 6)
Exit For
End If
Next i
Next j
End Sub

[/vba]

подскажите еще: как запустить макрос чтоб сравнивал разные столбцы?
пример вот рабочий макрос:
[vba]

Код