Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.89/18: Рейтинг темы: голосов - 18, средняя оценка - 4.89
0 / 0 / 0
Регистрация: 01.06.2014
Сообщений: 4
1

Поиск в двух столбцах

01.06.2014, 14:58. Показов 3442. Ответов 7
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Добрый день.
Задача такая: есть столбец А с номерами (условно) машин на странице Sheet1.
Есть столбец B с такими же данными на странице Sheet2.
Нужно найти для каждого номера из столбца А соответсвие в столбце В на странице Sheet2, определить строку в столбце В, и сделать с данными из других столбцов в этой строке некоторые действия. В принципе, в столбце В может быть несколько номеров, повторяющих номер из столбца А. А можем не быть ни одного.
Я это делаю двумя вложенными циклами. Верхний проходит по строкам столбца А, вложенный для каждой cells из А проверяет весь столбец В.
В общем-то, все работает, но я предполагаю, что это же можно сделать с меньшими затратами машинного времени. Или я ошибаюсь?
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
01.06.2014, 14:58
Ответы с готовыми решениями:

Поиск одинаковых чисел в двух столбцах
Excel Доброго времени суток, форумчане! Извините что напрягаю, но вот в чем загвоздка:...

Поиск .Find по двум полям в двух столбцах
Подскажите, пожалуйста, что нужно добавить в код With Worksheets('B').Range('E1:E650') Set C =...

Поиск схожих значений в двух столбцах и перенос из первого на другой лист
Добрый вечер! Идея такая! Есть Два столбца, Один большой, второй меньше, нужно найти значения из...

Проверка совпадений в двух столбцах
Sub Poisk() For a = 1 To 5 i = Cells(1, 5) m = Cells(a, 1) If i = m Then Cells(a, 2).Select...

7
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
01.06.2014, 16:18 2
Можно.
Данные из A в массив, его циклом в словарь.
Данные из B в массив, его циклом сверяем с словарём - если есть в словаре, то действуем в строке.
Будет значительно быстрее - и чем больше данных, тем больше будет разница скорости обработки.
0
0 / 0 / 0
Регистрация: 01.06.2014
Сообщений: 4
01.06.2014, 17:09  [ТС] 3
Данные из A в массив, его циклом в словарь.
А нет в запасниках какой-то ссылки, где можно почитать про работу со словарями? Я так сходу ничего толкового не нашел.
0
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
01.06.2014, 17:26 4
Лучший ответ Сообщение было отмечено wstil как решение

Решение

Ссылки - не по правилам (а на MSDN не знаю).
Но есть пример. Там кода всего 10 строк...
Вложения
Тип файла: xls CompareArrays.v03'.xls (48.0 Кб, 49 просмотров)
1
0 / 0 / 0
Регистрация: 01.06.2014
Сообщений: 4
08.06.2014, 15:50  [ТС] 5
Очень интересный пример, спасибо.
Подскажите, а как можно изменить код, если на Sheet2 в столбце А будут совпадающие значения? То есть будут 2 раза встречаться а2 с разными цифрами, и нужно эти цифры на Sheet3 просуммировать?
Я так полагаю, что если встречаются повторящиеся значения в первом столбце на странице2, то a(i, 3) = b(.Item(a(i, 1)), 2) работать как положено не будет?
0
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
08.06.2014, 16:24 6
В примере в файле сперва в словаре запоминается номер строки (массива) уникальных значений второго листа, затем при цикле по массиву первого листа эти значения подтягиваются. Но т.к. запоминается только один номер - то суммирование там не получится. Но зато из этой строки можно подтянуть хоть 1000 значений.
Если нужно суммировать одну позицию - можно сразу сумму собирать в словаре, затем из словаря и подставлять:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub compare()
    Dim tm!: tm = Timer
    Dim a(), b(), i&
 
    With Sheets(1)    'используется номер листа
        a = Range(.[c1], .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row)).Value
    End With
 
    With Sheets(2)    'используется номер листа
        b = Range(.[b1], .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row)).Value
    End With
 
    With CreateObject("Scripting.Dictionary")
 
        For i = 1 To UBound(b)
            .Item(b(i, 1)) = .Item(b(i, 1)) + b(i, 2)
        Next
 
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                a(i, 3) = .Item(a(i, 1))
            Else
                a(i, 3) = 0
            End If
        Next
    End With
 
    With Sheets(3)    'используется номер листа
        .[A1].Resize(i - 1, 3) = a
        .Activate
    End With
 
    MsgBox "Выполнено за " & Format((Timer - tm) / 24 / 60 / 60, "nn:ss") & " сек."
End Sub
Если же суммировать нужно много позиций/столбцов, то запоминать можно номер первого найденного значения, и затем суммировать в массиве по этому номеру. Пример писать лень - немного муторно, да и может и не нужно никому...
Если нужно - попробуйте самостоятельно, в этих двух примерах всё необходимое кажется есть.
1
0 / 0 / 0
Регистрация: 01.06.2014
Сообщений: 4
09.06.2014, 12:22  [ТС] 7
Я тут посидел на выходных, поразмышлял, и так и не придумал, как можно применить словарь к своей задаче.
Алгоритм у меня в конкретной задаче такой:
1. Берется страница Sheet(1401_1402) с данными, загоняется полностью в массив а() (14 столбцов)
2. Берем массив b(), и перегоняем циклом данные из 2-х нужных столбцов в этот массив, при это обрабатывая данные из одного из столбцов (в столбце идентификаторы, у каких-то мы отрезаем лишние цифры (P.26004.09.658.11 -> P.26004), у каких-то отрезаем первые четыре символа.
3. В третий массив с() перегоняем вложенным циклом эти два столбца из массива b(), но уже суммируя строки с одинаковыми идентификаторами (были, скажем, 2 разных идентификатора P.26004.09.658.11 и P.26004.12.758.51, а стал один P.26004).
4. Потом уже берем данным из соответствующего столбца страницы Sheet(CER), сравниваем вложенным циклом каждый идентификатор из этого столбца [они тут уже приведенные к тому виду, который был получен при переводе b()->c()] с идентификаторами в массиве c(), и прописываем идентификатору соответствующую сумму.

Иногда на изначальной странице идентификаторы разбросаны по нескольким столбцам, и приходится при перегоне из массива а() в массив b() делать что-то вроде if a(i,10)<>Empty then ... else if a(i,11)<> empty then ... ну и т.д.

Можно упростить решение такой задачи с помощью словарей?

Код выглядит так:
Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit
 
Sub CER_1401_1402()
Dim a(), b(), c()
Dim i, k, n, m, iLong, iLong1401 As Integer
Dim s, str1 As String
Dim sum1 As Long
 
a = Sheets("1401_1402").UsedRange.Value 'çàïèñü â ìàññèâ âñåé ñòðàíèöû 1401_1402
 
ReDim b(UBound(a), 1) 'îïðåäåëåíèå ðàçìåðíîñòè ìàññèâà b
For i = 2 To UBound(a) 'çàïîëíåíèå ìàññèâà b ñòîëáöàìè 8 è 14 èç à, è îòðåçàíèå ëèøíèõ çíàêîâ
        If Left(a(i, 14), 3) = "ORD" Or Left(a(i, 14), 3) = "ÇÊÇ" Then
            b(i - 2, 0) = Right(a(i, 14), 12)
            b(i - 2, 1) = a(i, 8)
            End If
        If Left(a(i, 14), 3) = "WBS" Or Left(a(i, 14), 3) = "ÑÏÏ" Then
            b(i - 2, 0) = Mid(a(i, 14), 5, 7)
            b(i - 2, 1) = a(i, 8)
            End If
        
       Next
       
ReDim c(UBound(b), 1)
 
m = 1
For i = 0 To UBound(b) 'çàïîëíåíèå ìàññèâà ñ ñòîëáöàìè 0 è 1 èç b, ïàðàëëåëüíî ñóììèðîâàíèå îäèíàêîâûõ íîìåðîâ
    n = 0
    If i = 0 Then
        c(0, 0) = b(0, 0)
        c(0, 1) = b(0, 1)
        End If
    If i > 0 Then
        For k = 0 To m
            If c(k, 0) = b(i, 0) Then
            n = 1
            c(k, 1) = c(k, 1) + b(i, 1)
            End If
            Next
        If n = 0 Then
            c(m, 0) = b(i, 0)
            c(m, 1) = c(m, 1) + b(i, 1)
            m = m + 1
            End If
        End If
            
       Next
       
Sheets("1401_1402_proc").Range("a2:b" & UBound(c) + 1).Value = c 'âûâîä ìàññèâà c íà ëèñò
 
iLong = Sheets("1401_1402_proc").Cells(2, 7).Value 'ñðàâíåíèå äàííûõ èç ìàññèâà c() è ñòîëáöà ñ íîìåðàìè èíâåñòïðîåêòîâ ñî ñòðàíèöû CER_Status
For i = 3 To iLong
    k = 0
    s = Sheets("CER_status").Cells(i, 5)
    If Sheets("CER_status").Cells(i, 5) = Empty Then GoTo Next1
    While k <= UBound(c) And n <> 100
        If Sheets("CER_status").Cells(i, 5) = c(k, 0) Then
            Sheets("CER_status").Cells(i, 14) = c(k, 1)
            n = 100
            End If
        k = k + 1
        Wend
    n = 1
Next1:
    Next
 
'iLong1401 = Sheets("1401_1402_proc").Cells(5, 7).Value 'Ïðîâåðêà íà íàëè÷èå âñåõ çíà÷åíèé â òàáëèöå èç òàáëèöû ÑÀÏ
 
a = Sheets("1401_1402_proc").UsedRange.Value
 
For k = 0 To UBound(c) - 2
    i = 3
    n = 1
    While i <= iLong And n <> 100
            s = Sheets("CER_status").Cells(i, 5)
        If Sheets("CER_status").Cells(i, 5) = c(k, 0) Then
            Sheets("1401_1402_proc").Cells(k + 2, 3) = "Íàéäåí"
            n = 100
            End If
        If n = 1 Then Sheets("1401_1402_proc").Cells(k + 2, 3).Value = "Èíâåñòïðîåêò â CER_status íå íàéäåí!"
 
        i = i + 1
        Wend
    n = 1
 
    Next
        
 
End Sub


З.Ы. Во вложении файл с примером, если нужно.
Вложения
Тип файла: 7z пример.7z (93.7 Кб, 13 просмотров)
0
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
09.06.2014, 13:28 8
Не понял зачем там третий лист - из описания не понятно, а в код не вникал, больно много всего...
Исходя из описания простой алгоритм на словаре такой:
1. Данные из CER_status в массив, его перебором в словарь - запоминаем позицию каждого уникального (строку). Т.е. ключ=1CR181100102, Item=3.
2. Создаём пустой массив для результата (аналогичный по высоте).
3. Данные двух столбцов листа 1401_1402 в два массива.
4. Цикл по массиву из 14-го столбца, получаем из данных ключ словаря (Вашим хитрым алгоритмом), проверяем его наличие в словаре - если есть, то из словаря берём номер строки массива, в нём собираем сумму (к тому что там есть прибавляем значение массива из 8-го столбца).
5. выгружаем собранное.

Если нужно добавить к тому, что уже есть на листе - то массив не создаём, а берём с листа с тем, что там уже есть.

Добавлено через 20 минут
Вот например так (но в примере совпадений нет - я создал искусственно):
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub tt()
    Dim a(), aa(), i&, t$
 
    With CreateObject("Scripting.Dictionary"): .comparemode = 1
        With Sheets("CER_status")
            i = .Cells(.Rows.Count, 5).End(xlUp).Row
            a = .Range("E1:E" & i).Value
            ReDim b(1 To UBound(a), 1 To 1)
        End With
        For i = 1 To UBound(a)
            If Len(a(i, 1)) Then .Item(Trim(a(i, 1))) = i
        Next
 
        With Sheets("1401_1402")
            i = .Cells(.Rows.Count, 8).End(xlUp).Row
            a = .Range("N1:N" & i).Value
            aa = .Range("H1:H" & i).Value
        End With
 
        For i = 1 To UBound(a)
            Select Case True
            Case Left(a(i, 1), 3) = "ORD"
                t = Right(a(i, 1), 12)
            Case Left(a(i, 1), 3) = "ЗКЗ"
                t = Right(a(i, 1), 12)
            Case Left(a(i, 1), 3) = "WBS"
                t = Mid(a(i, 1), 5, 7)
            Case Left(a(i, 1), 3) = "СПП"
                t = Mid(a(i, 1), 5, 7)
            Case Else
                t = a(i, 1)
            End Select
 
            If .exists(t) Then b(.Item(t), 1) = b(.Item(t), 1) + aa(i, 1)
        Next
 
    End With
 
    Sheets("CER_status").Range("M1").Resize(UBound(b), 1) = b
End Sub
0
09.06.2014, 13:28
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
09.06.2014, 13:28
Помогаю со студенческими работами здесь

Сравнение значений в двух столбцах
Доброго времени суток! Помогите пожалуйста написать макрос для такой задачи: * следует...

Удаление совпадающих записей в двух столбцах
Здравствуйте. В excel необходимо сравнить два столбца и удалить совпадающие записи. Пример: 1 2...

Макрос для сравнения данных в двух столбцах, вместо vlookup
Подскажите, пожалуйста, как написать макрос, который бы можно было использовать для сравнения...

Поиск и сравнение значений в столбцах по двум параметрам
Добрый день. Помогите с проблемой. В VBA не силен, но очень СРОЧНО нужно. Буду рад любой помощи....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru