Сопоставление значений из 2 разных .xls файлов

@stosstruppen · Регистрация: 29.10.2013

Author24 — интернет-сервис помощи студентам

Здравствуйте.
Есть задача:
есть 2 екселевских файла, файл "А" и файл "Б", в файле "а" есть столбец значений 10 строчек, в файле "Б" тоже есть стобец значений но уже на 70 строчек, задача вот в чём, нужна программа, которая сначала будет запоминать значения из столбца файла "а", а потом в столбце файла "Б" будет искать значения которые совпадают со значениями из файла "а" и те строки в которых соответствия будут найдены, красить в какой нибудь цвет (любой красный зелёный неважно).

@Hugo121 · 29.10.2013, 13:07

Быстрее будет ВПР() или СЧЁТЕСЛИ() в УФ вставить, чем программу ждать. На 70 строк вполне.

@stosstruppen · 29.10.2013, 13:40 **[ТС]**

Я полнейший дуб в вопросах программирования, объединил всё в один файл, теперь в стобце C висят значения которые надо запоминать, а в столбце A которые надо сверять и перекрашивать, используя остатки мозга и информацию я по быстрому родил вот что:

Visual Basic

Sub S()
For x = c1 To c150
    For y = a1 To a150
        If y = x Then
            cel.Interior.Color = 9
        End If
    Next
Next
End Sub

однако не работает моё детище (ПЕРВОЕ КСТАТИ!) говорит can`t execute in break mode. VBA выделяет жёлтым почему то именно 1 строку которая SUB S () но я не могу понять в чём там может быть ошибка

@Hugo121 · 29.10.2013, 14:17

Да уж... Выглядит конечно красиво, но столько ошибок!
Можно как пример приводить

Даже не знаю что править...
Может всёж файл с данными покажете - вот на нём кто-нибудь рабочий код и покажет?

@stosstruppen · 29.10.2013, 14:23 **[ТС]**

а ы...да конечно)) сейчас вот он родимый. Ошибки неизбежны, это то, чему я научился с нуля за полтора часа)) так что любой помощи и замечаниям буду рад))

@Hugo121 · 29.10.2013, 14:23

Ну например так исправил, основываясь на Вашем коде. Найдите 10 отличий

Visual Basic

Sub S()
    Dim r As Range, rr As Range
    For Each r In Range("c1:c150")
        For Each rr In Range("a1:a150")
            If r = rr Then
                r.Interior.Color = vbRed
                'или
                'rr.Interior.Color = vbRed
            End If
        Next
    Next
End Sub

@stosstruppen · 29.10.2013, 14:25 **[ТС]**

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

@Hugo121 · 29.10.2013, 14:59

Посмотрел пример - нет там ни одного совпадения, можете не волноваться

Вообще думаю в азы нужно занести - работа напрямую с ячейками в десятки раз медленнее, чем работа с данными этих ячеек в памяти (в массиве). Как-то замерял - получилось 43 раза.
Но в данном примере конечно сильно ощутимой разницы нет, т.к. строк всего 150, но цикл в цикле по 150 ячейкам всёж уже немного заметен.
Вот если взять данные сперва в массив, затем перебирать цикл в цикле их, и идти на лист только чтоб покрасить - будет глазу незаметно.
Ещё быстрее - взять в массив (или два), занести один список в словарь (один цикл по массиву), затем при втором цикле по массиву проверить по словарю наличие данных.
Т.е. всего 2 прохода по данным и поиск в словаре.
В результате получаем номер строки, в которой нужно закрасить ячейку. Можно красить сразу, можно собрать эти диапазоны в union и закрасить сразу всё.
Или поставить на лист метки (используя массив), отсортировать по ним лист, закрасить сразу весь блок строк.
Хотя возможно для задачи "определить что повторяется" достаточно просто поставить метки. Или получить отдельно список этих повторяющихся номеров. Или удалить эти номера из исходного массива. Или...
Я бы в любом случае делал на массивах и словаре (или коллекции, в зависимости от задачи - всёж коллекция побыстрее словаря).

toiai · 29.10.2013, 22:16

Вот по рекомендации Hugo121 можно сделать все в один цикл:

Visual Basic

Sub S()
    Dim r As Range, rr As Range
    With New Collection
        On Error Resume Next
        For Each r In Range("c1:c150")
            .Add r.Value, CStr(r.Value)
            If Err Then
                r.Interior.Color = vbRed
                Err.Clear
            End If
        Next
    End With
End Sub

@Igor_Tr · 29.10.2013, 23:18

To stosstruppen. Здравствуйте. А вот можна узнать? Эти раскраски листа - они Вам что-то дают? Или Вы потом ориентируетесь кодом по цвету? Если данных много - я просто не пойму, зачем тогда все эти "пятна". Но, в принципе, я и в graffiti полный профан (отстал, наверно, от жизни

)

@stosstruppen · 30.10.2013, 04:43 **[ТС]**

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

@rRczZZ · 30.10.2013, 06:41

Держи.
В коде макроса указать нужные диапазоны (столбец ключей и целевой столбец). Поиск ведет по полному соответствию содержимого ячеек. Собственно ключи добавляются в коллекцию, при поиске определяется есть ли такой ключ или нет. Заметил, что в ячейках есть лишние пробелы, они убираются функцией Trim. Можно еще приводить все к нижнему регистру функцией LCase.

Чтобы записать значения из диапазона на листе в массив используется следующий код

Visual Basic

Dim buff as Variant
buff = Range("A1:B10")
   ' buff станет Array(1 to 10, 1 to 2)
   ' buff(5, 2) - значение ячейки "B5"
   ' Функциями LBound/UBound (buff, 1 или 2) можно получить нижние и верхние границы массива

@stosstruppen · 30.10.2013, 11:20 **[ТС]**

тысяча благодарностей)) работает))

@Hugo121 · 30.10.2013, 13:06

Афигеть... Это я заглянул в файл

Серьёзно выглядит... Куда там нам со словарями в 3 строки...

Кстати, у меня не фурычит - 2003 тут у меня

Добавлено через 8 минут
Вот мои 3 строки

Visual Basic

Option Explicit
 
Sub tt()
    Dim a(), i&
 
    With [a1].CurrentRegion
        .Interior.Pattern = xlNone
        a = .value
    End With
    
    With CreateObject("Scripting.Dictionary"): .CompareMode = 1
        For i = 2 To UBound(a): .Item(a(i, 1)) = 0&: Next
        For i = 2 To UBound(a)
            If .Exists(a(i, 2)) Then Cells(i, 2).Interior.Color = vbRed
        Next
    End With
 
End Sub

Добавлено через 6 минут
Про 3 не шутил, можно впихнуть:

Visual Basic

1
2
3

Sub tt(): Dim a(), i&: With [a1].CurrentRegion: .Interior.Pattern = xlNone: a = .value: End With
    With CreateObject("Scripting.Dictionary"): .CompareMode = 1: For i = 2 To UBound(a): .Item(a(i, 1)) = 0&: Next
        For i = 2 To UBound(a): Cells(i, 2).Interior.ColorIndex = (Not .Exists(a(i, 2))) + 3: Next: End With: End Sub

Добавлено через 3 минуты
Хотя конечно (Not .Exists(a(i, 2))) + 3 тонкое ущербное место...

Добавлено через 2 минуты
Лучше эту часть так написать:

Visual Basic

1	Cells(i, 2).Interior.ColorIndex = IIf((Not .Exists(a(i, 2))) + 3 = 3, 3, xlNone)

и тогда становится лишним

Visual Basic

1	.Interior.Pattern = xlNone

Добавлено через 3 минуты
Ну и тогда уже 2 строки:

Visual Basic

1
2

Sub tt(): Dim a(), i&: a = [a1].CurrentRegion.value: With CreateObject("Scripting.Dictionary"): .CompareMode = 1: For i = 2 To UBound(a): .Item(a(i, 1)) = 0&: Next
        For i = 2 To UBound(a): Cells(i, 2).Interior.ColorIndex = IIf((Not .Exists(a(i, 2))) + 3 = 3, 3, xlNone): Next: End With: End Sub

@stosstruppen · 01.11.2013, 10:42 **[ТС]**

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

Visual Basic

Sub Ìàêðîñ2()
For X = 1 To 100
    If Cells(X, 1).Value <> "" Then
        For Y = 1 To 1000
            StrX = Trim(Replace(Cells(X, 1).Value, Chr(160), ""))
            StrY = Trim(Replace(Cells(Y, 2).Value, Chr(160), ""))
            If StrX = StrY Then
                Cells(Y, 2).Interior.Color = RGB(255, 0, 0)
            End If
        Next
    End If
Next
 
End Sub

Добавлено через 7 минут
блин опять неправильно теги расставил

@Hugo121 · 01.11.2013, 11:58

Сравните (обновление специально не отключал):

Visual Basic

Sub t1()
    tm = Timer
    For X = 1 To 100
        If Cells(X, 1).Value <> "" Then
            For Y = 1 To 1000
                StrX = Trim(Replace(Cells(X, 1).Value, Chr(160), ""))
                StrY = Trim(Replace(Cells(Y, 2).Value, Chr(160), ""))
                If StrX = StrY Then
                    Cells(Y, 2).Interior.Color = RGB(255, 0, 0)
                End If
            Next
        End If
    Next
    Debug.Print Timer - tm
End Sub
 
Sub t2()
    tm = Timer
    For X = 1 To 100
        If Cells(X, 1).Value <> "" Then
            StrX = Trim(Replace(Cells(X, 1).Value, Chr(160), ""))
            For Y = 1 To 1000
                StrY = Trim(Replace(Cells(Y, 2).Value, Chr(160), ""))
                If StrX = StrY Then
                    Cells(Y, 2).Interior.Color = RGB(255, 0, 0)
                End If
            Next
        End If
    Next
    Debug.Print Timer - tm
End Sub
 
Sub t3()
    tm = Timer
    Dim a(), i&: a = [a1:a100].Value
    With CreateObject("Scripting.Dictionary"): .CompareMode = 1
        For i = 1 To UBound(a): .Item(Trim(Replace(a(i, 1), Chr(160), ""))) = 0&: Next
        For i = 1 To 1000
            If .Exists(Trim(Replace(Cells(i, 2).Value, Chr(160), ""))) Then
                Cells(i, 2).Interior.Color = RGB(255, 0, 0)
            End If
        Next
    End With
    Debug.Print Timer - tm
End Sub

Добавлено через 12 минут
Там 3 кода! Не пропустите последний!

@stosstruppen 0 / 0 / 0 Регистрация: 29.10.2013 Сообщений: 7
		1
	Сопоставление значений из 2 разных .xls файлов 29.10.2013, 12:51. Показов 1808. Ответов 15 Метки нет (Все метки) Здравствуйте. Есть задача: есть 2 екселевских файла, файл "А" и файл "Б", в файле "а" есть столбец значений 10 строчек, в файле "Б" тоже есть стобец значений но уже на 70 строчек, задача вот в чём, нужна программа, которая сначала будет запоминать значения из столбца файла "а", а потом в столбце файла "Б" будет искать значения которые совпадают со значениями из файла "а" и те строки в которых соответствия будут найдены, красить в какой нибудь цвет (любой красный зелёный неважно). 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	29.10.2013, 13:07	2
	Быстрее будет ВПР() или СЧЁТЕСЛИ() в УФ вставить, чем программу ждать. На 70 строк вполне. 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	29.10.2013, 14:17	4
	Да уж... Выглядит конечно красиво, но столько ошибок! Можно как пример приводить Даже не знаю что править... Может всёж файл с данными покажете - вот на нём кто-нибудь рабочий код и покажет? 1

@stosstruppen 0 / 0 / 0 Регистрация: 29.10.2013 Сообщений: 7
	29.10.2013, 14:25 [ТС]	7
	спасибо большое)) конечно понятно что начинать надо с азов, и курить книги для начала) 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	29.10.2013, 14:59	8
	Посмотрел пример - нет там ни одного совпадения, можете не волноваться Вообще думаю в азы нужно занести - работа напрямую с ячейками в десятки раз медленнее, чем работа с данными этих ячеек в памяти (в массиве). Как-то замерял - получилось 43 раза. Но в данном примере конечно сильно ощутимой разницы нет, т.к. строк всего 150, но цикл в цикле по 150 ячейкам всёж уже немного заметен. Вот если взять данные сперва в массив, затем перебирать цикл в цикле их, и идти на лист только чтоб покрасить - будет глазу незаметно. Ещё быстрее - взять в массив (или два), занести один список в словарь (один цикл по массиву), затем при втором цикле по массиву проверить по словарю наличие данных. Т.е. всего 2 прохода по данным и поиск в словаре. В результате получаем номер строки, в которой нужно закрасить ячейку. Можно красить сразу, можно собрать эти диапазоны в union и закрасить сразу всё. Или поставить на лист метки (используя массив), отсортировать по ним лист, закрасить сразу весь блок строк. Хотя возможно для задачи "определить что повторяется" достаточно просто поставить метки. Или получить отдельно список этих повторяющихся номеров. Или удалить эти номера из исходного массива. Или... Я бы в любом случае делал на массивах и словаре (или коллекции, в зависимости от задачи - всёж коллекция побыстрее словаря). 0

@Igor_Tr 4377 / 661 / 36 Регистрация: 17.01.2010 Сообщений: 2,134
	29.10.2013, 23:18	10
	To stosstruppen. Здравствуйте. А вот можна узнать? Эти раскраски листа - они Вам что-то дают? Или Вы потом ориентируетесь кодом по цвету? Если данных много - я просто не пойму, зачем тогда все эти "пятна". Но, в принципе, я и в graffiti полный профан (отстал, наверно, от жизни ) 0

@stosstruppen 0 / 0 / 0 Регистрация: 29.10.2013 Сообщений: 7
	30.10.2013, 11:20 [ТС]	13
	тысяча благодарностей)) работает)) 0