Доброго времени суток всем Прошу помощи. Написать небольшую програмку в екзель. Имеются 2 больших столбца - списка названий изображений. Необходимо из первого столбца вывести названия изображений, которых нет во втором столбце. Приэтом первый столбец размером в ~6 тысяч строк, а второй в ~13 тысяч. В Интернете я нашел примерное решение через формулу, но оно не корректно работает. Забил все значения. Прикрепляю файл с тем, что нашел и необходимыми значениями.
Доброго времени суток всем Прошу помощи. Написать небольшую програмку в екзель. Имеются 2 больших столбца - списка названий изображений. Необходимо из первого столбца вывести названия изображений, которых нет во втором столбце. Приэтом первый столбец размером в ~6 тысяч строк, а второй в ~13 тысяч. В Интернете я нашел примерное решение через формулу, но оно не корректно работает. Забил все значения. Прикрепляю файл с тем, что нашел и необходимыми значениями.DimentR
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(a): dic.Add a(i, 1), 0: Next For i = 1 To UBound(b): dic.Delete b(i, 1): Next [c1].Resize(dic.Count).Value = Application.Transpose(dic.keys) End Sub
[/vba]
[vba]
Код
Sub t() Dim a, b, dic, i&
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(a): dic.Add a(i, 1), 0: Next For i = 1 To UBound(b): dic.Delete b(i, 1): Next [c1].Resize(dic.Count).Value = Application.Transpose(dic.keys) End Sub
Так попробуй Я проверил - он при попытке добавить уже существующее значение переходит по ошибке на For i = 1 To UBound(b) А мой просто заменяет Item на новый 0
Так попробуй Я проверил - он при попытке добавить уже существующее значение переходит по ошибке на For i = 1 To UBound(b) А мой просто заменяет Item на новый 0 Hugo
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(a): dic.Add a(i, 1), 0: Next For i = 1 To UBound(b): dic.Delete b(i, 1): Next [c1].Resize(dic.Count).Value = Application.Transpose(dic.keys) End Sub
Спасибо за ответ, но Ваш макрос не дал нужного результата. А именно... первые три тысячи строк скопировались из первого столбца во второй. Это, пожалуй, единственное что произошло) Может быть я что-то не так делаю. Не знаю.
Цитата (ikki)
Sub t() Dim a, b, dic, i&
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(a): dic.Add a(i, 1), 0: Next For i = 1 To UBound(b): dic.Delete b(i, 1): Next [c1].Resize(dic.Count).Value = Application.Transpose(dic.keys) End Sub
Спасибо за ответ, но Ваш макрос не дал нужного результата. А именно... первые три тысячи строк скопировались из первого столбца во второй. Это, пожалуй, единственное что произошло) Может быть я что-то не так делаю. Не знаю.DimentR
Сообщение отредактировал DimentR - Воскресенье, 06.01.2013, 22:01
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(a): dic.Item(a(i, 1)) = 0&: Next For i = 1 To UBound(b): dic.Delete b(i, 1): Next [c1].Resize(dic.Count).Value = Application.Transpose(dic.keys) End Sub
[/vba]
пс. на ваших данных - всего на три строчки короче списка в ст. А. вернее - на две. одно повторяющееся значение я добавлял для теста.
с учетом очень важного замечания Hugo:
[vba]
Код
Sub t() Dim a, b, dic, i&
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(a): dic.Item(a(i, 1)) = 0&: Next For i = 1 To UBound(b): dic.Delete b(i, 1): Next [c1].Resize(dic.Count).Value = Application.Transpose(dic.keys) End Sub
[/vba]
пс. на ваших данных - всего на три строчки короче списка в ст. А. вернее - на две. одно повторяющееся значение я добавлял для теста.ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
Сообщение отредактировал ikki - Воскресенье, 06.01.2013, 22:10
Спасибо за старание, но я все равно не понимаю (по незнанию) что именно делает Ваш макрос. Он меняет что-то во втором столбце. Все. Возможно сделать так, что бы значения выводились в третий столбец?
Спасибо за старание, но я все равно не понимаю (по незнанию) что именно делает Ваш макрос. Он меняет что-то во втором столбце. Все. Возможно сделать так, что бы значения выводились в третий столбец?DimentR
Я как сторона незаинтересованная могу сказать - этот код из первого и второго столбцов только берёт данные, никак их не меняя. Результат выгружается в столбец C.
Я как сторона незаинтересованная могу сказать - этот код из первого и второго столбцов только берёт данные, никак их не меняя. Результат выгружается в столбец C.Hugo
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value n = IIf(UBound(a) > UBound(b), UBound(a), UBound(b)) ReDim c(1 To n, 1 To 1)
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(b) dic.Item(b(i, 1)) = 0& Next For i = 1 To UBound(a) If Not dic.exists(a(i, 1)) Then j = j + 1: c(j, 1) = a(i, 1) Next [c1].Resize(j).Value = c End Sub
[/vba]
[vba]
Код
Sub t() Dim a, b, c, dic, n&, i&, j&
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value n = IIf(UBound(a) > UBound(b), UBound(a), UBound(b)) ReDim c(1 To n, 1 To 1)
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(b) dic.Item(b(i, 1)) = 0& Next For i = 1 To UBound(a) If Not dic.exists(a(i, 1)) Then j = j + 1: c(j, 1) = a(i, 1) Next [c1].Resize(j).Value = c End Sub
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value n = IIf(UBound(a) > UBound(b), UBound(a), UBound(b)) ReDim c(1 To n, 1 To 1)
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(b) dic.Item(b(i, 1)) = 0& Next For i = 1 To UBound(a) If Not dic.exists(a(i, 1)) Then j = j + 1: c(j, 1) = a(i, 1) Next [c1].Resize(j).Value = c End Sub
Спасибо огромное, ребят! Все так, как надо, как я и просил. Еще раз спасибо! Очень помогли!
Цитата (ikki)
Sub t() Dim a, b, c, dic, n&, i&, j&
a = Range([a1], [a1].End(xlDown)).Value b = Range([b1], [b1].End(xlDown)).Value n = IIf(UBound(a) > UBound(b), UBound(a), UBound(b)) ReDim c(1 To n, 1 To 1)
Set dic = CreateObject("scripting.dictionary")
On Error Resume Next For i = 1 To UBound(b) dic.Item(b(i, 1)) = 0& Next For i = 1 To UBound(a) If Not dic.exists(a(i, 1)) Then j = j + 1: c(j, 1) = a(i, 1) Next [c1].Resize(j).Value = c End Sub
Спасибо огромное, ребят! Все так, как надо, как я и просил. Еще раз спасибо! Очень помогли!DimentR
Чисто вдогонку не премину при удобном наглядном случае вспомнить об альтернативной мощи SQL:
[vba]
Код
Sub selectData()
Dim rst As Object Set rst = CreateObject("ADODB.Recordset")
rst.Open _ "SELECT a.F1 FROM [Лист1$] AS a LEFT JOIN [Лист1$] AS b ON a.F1 = b.F2 " & _ "WHERE a.F1 Is Not Null AND b.F2 Is Null" _ , _ "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ThisWorkbook.FullName & ";" & _ "Extended Properties='Excel 12.0;HDR=No'"
[Лист1!E1].CopyFromRecordset rst
End Sub
[/vba] Результат - в колонке E.
Чисто вдогонку не премину при удобном наглядном случае вспомнить об альтернативной мощи SQL:
[vba]
Код
Sub selectData()
Dim rst As Object Set rst = CreateObject("ADODB.Recordset")
rst.Open _ "SELECT a.F1 FROM [Лист1$] AS a LEFT JOIN [Лист1$] AS b ON a.F1 = b.F2 " & _ "WHERE a.F1 Is Not Null AND b.F2 Is Null" _ , _ "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ThisWorkbook.FullName & ";" & _ "Extended Properties='Excel 12.0;HDR=No'"
По времени у меня получается: SQL - 0,42-0,45 сек, словарь - 0,06-0,08 сек. Так что, если для кого-то критично, то конечно словарь - он в 6-7 раз быстрее
Мне же SQL дороже концептуальнее - даже если бы он был 2-3 секунды, я бы ждал... терпеливо!
По времени у меня получается: SQL - 0,42-0,45 сек, словарь - 0,06-0,08 сек. Так что, если для кого-то критично, то конечно словарь - он в 6-7 раз быстрее
Мне же SQL дороже концептуальнее - даже если бы он был 2-3 секунды, я бы ждал... терпеливо! Gustav
поэкспериментировал чуток... у меня Ex'2003, переписал так:
[vba]
Код
Sub selectData() Dim rst As Object, t&, cnStr$ t = GetTickCount
Set rst = CreateObject("ADODB.Recordset") cnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & ThisWorkbook.FullName & ";" & _ "Extended Properties='Excel 8.0;HDR=No'" rst.Open _ "SELECT a.F1 FROM [Лист1$] AS a LEFT JOIN [Лист1$] AS b ON a.F1 = b.F2 " & _ "WHERE a.F1 Is Not Null AND b.F2 Is Null", cnStr [Лист1!f1].CopyFromRecordset rst Debug.Print GetTickCount - t End Sub
[/vba]
по времени результаты аналогичные
попробовал "укоротить" диапазоны, изменив [vba]
Код
... Dim lrA&, lrB&
lrA = Cells(Rows.Count, 1).End(xlUp).Row lrB = Cells(Rows.Count, 2).End(xlUp).Row ... rst.Open _ "SELECT a.F1 FROM [Лист1$A1:A" & lrA & "] AS a LEFT JOIN [Лист1$B1:B" & lrB & "] AS b ON a.F1 = b.F1 " & _ "WHERE a.F1 Is Not Null AND b.F1 Is Null", cnStr
[/vba] никакого ускорения не заметил.
и - главный вопрос я бы (по незнанию) написал запрос примерно так: [vba]
Код
rst.Open _ "SELECT a.F1 FROM [Лист1$A1:A" & lrA & "] AS a " & _ "WHERE a.F1 NOT IN (SELECT b.F1 FROM [Лист1$B1:B" & lrB & "] AS b)", cnStr
[/vba]
такой запрос компилируется и запускается, но результата я не дождался Gustav, проконсультируйте, плиз: это вообще неправильный путь или "просто" неоптимальный (мягко говоря)?
поэкспериментировал чуток... у меня Ex'2003, переписал так:
[vba]
Код
Sub selectData() Dim rst As Object, t&, cnStr$ t = GetTickCount
Set rst = CreateObject("ADODB.Recordset") cnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & ThisWorkbook.FullName & ";" & _ "Extended Properties='Excel 8.0;HDR=No'" rst.Open _ "SELECT a.F1 FROM [Лист1$] AS a LEFT JOIN [Лист1$] AS b ON a.F1 = b.F2 " & _ "WHERE a.F1 Is Not Null AND b.F2 Is Null", cnStr [Лист1!f1].CopyFromRecordset rst Debug.Print GetTickCount - t End Sub
[/vba]
по времени результаты аналогичные
попробовал "укоротить" диапазоны, изменив [vba]
Код
... Dim lrA&, lrB&
lrA = Cells(Rows.Count, 1).End(xlUp).Row lrB = Cells(Rows.Count, 2).End(xlUp).Row ... rst.Open _ "SELECT a.F1 FROM [Лист1$A1:A" & lrA & "] AS a LEFT JOIN [Лист1$B1:B" & lrB & "] AS b ON a.F1 = b.F1 " & _ "WHERE a.F1 Is Not Null AND b.F1 Is Null", cnStr
[/vba] никакого ускорения не заметил.
и - главный вопрос я бы (по незнанию) написал запрос примерно так: [vba]
Код
rst.Open _ "SELECT a.F1 FROM [Лист1$A1:A" & lrA & "] AS a " & _ "WHERE a.F1 NOT IN (SELECT b.F1 FROM [Лист1$B1:B" & lrB & "] AS b)", cnStr
[/vba]
такой запрос компилируется и запускается, но результата я не дождался Gustav, проконсультируйте, плиз: это вообще неправильный путь или "просто" неоптимальный (мягко говоря)?ikki
помощь по Excel и VBA ikki@fxmail.ru, icq 592842413, skype alex.ikki
Сообщение отредактировал ikki - Понедельник, 07.01.2013, 21:45
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
)
