SERGE_BLIZNUK
Silver Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Модуль переноса недостающих данных с одного листа (w2) на другой лист (w1).
Имена нужных книг/листов прописать в Set w1 = ... Set w2 = ...
Код:
Public Sub AddMissingDataFromSheet2()
' оригинальная идея: (c) AndVGri
'В редакторе VBA в меню Tools, пункт Reference
' в диалоге поставте галочку для Microsoft Scripting Runtime.
Dim pAll As New Scripting.Dictionary
Dim rowLast As Long, Column_A As Long, RowLast2 As Long
Dim RowNewCount As Long
Dim w1 As Worksheet, w2 As Worksheet
Dim iRow As Long, iCol As Long, vEntry As String
Set w1 = Workbooks("Книга1.xls").Worksheets("Лист1")
Set w2 = Workbooks("Книга2.xls").Worksheets("Лист1")
Column_A = 1&
rowLast = Cells(w1.UsedRange.Rows.Count + 1, Column_A).End(xlUp).Row
' сохраним весь столбец А в Scripting.Dictionary для удобства поиска
For iRow = 1& To rowLast
vEntry = CStr(w1.Cells(iRow, Column_A).Value)
If Not pAll.Exists(vEntry) Then
pAll.Add vEntry, iRow
End If
Next iRow
RowNewCount = rowLast + 1
RowLast2 = w2.Cells(w2.UsedRange.Rows.Count + 1, Column_A).End(xlUp).Row
If RowLast2 > 60000 Then
MsgBox "Ой, что-то не так со вторым листом... Ничего не делаем!"
Exit Sub
End If
For iRow = 1& To RowLast2
vEntry = CStr(w2.Cells(iRow, Column_A).Value)
If Not pAll.Exists(vEntry) Then
w1.Cells(RowNewCount, Column_A).Value = vEntry
RowNewCount = RowNewCount + 1
End If
Next iRow
End Sub
|
|
