Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.01.2011, 09:49   #1
pechenushka_xxx
 
Регистрация: 28.01.2011
Сообщений: 3
Печаль Сравнение ячеек из разных таблиц

Помогите пожалуйста, у меня есть две таблицы,в одной столбец неизвестной длины(он периодически меняется) в нем указан код из цифр, в другой таблице два столбца,1-код,2-названия кода. Мне надо,чтобы шло сравнение первой таблицы столбца код,со второй таблицей столбец код,если совпадение, то в первой таблице добавляется столбец и рядос с тем кодом который совпал пишется название кода,которое копиретутся из 2 таблице. Я сделала макрос, но у меня проблема, код пожет повторятся, а у меня только берет первый и повторные не смотрит. Помогите.

Sub ЛПУ()

Dim i As Long, j As Long, k As Long, x As Range, a(): Application.ScreenUpdating = False
With ThisWorkbook.Sheets(1) //активна таблица 2
a = .Range(.[A2], .Cells(Rows.Count, "B").End(xlUp)).Value
End With
Workbooks("expertiza1.xls").Sheets( 1).Activate: j = 72 // таблица 1
For i = 1 To UBound(a, 1) Step 1
Set x = [C:C].Find(what:=a(i, 1), LookAt:=xlWhole)
If x Is Nothing Then
k = Cells(Rows.Count, 1).End(xlUp).Row

Cells(k, 3) = a(i, 1)
Cells(k, j) = a(i, 2)

Else
Cells(x.Row, j) = a(i, 2)

End If
Next

End Sub
pechenushka_xxx вне форума Ответить с цитированием
Старый 28.01.2011, 09:52   #2
pechenushka_xxx
 
Регистрация: 28.01.2011
Сообщений: 3
По умолчанию

Прилагаются 2 таблички
Вложения
Тип файла: rar таблицы.rar (47.6 Кб, 30 просмотров)
pechenushka_xxx вне форума Ответить с цитированием
Старый 28.01.2011, 10:02   #3
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Для того, чтобы найти все совпадения, нужно использовать метод FindNext.
Вместо Вашего макроса используйте следующий:
Код:
Sub ЛПУ()
    Dim i As Long, j As Long, k As Long, x As Range, a(), fst As String
    Application.ScreenUpdating = False
    With ThisWorkbook.Sheets(1): a = .Range(.[A2], .Cells(Rows.Count, "B").End(xlUp)).Value: End With
    Workbooks("expertiza1.xls").Sheets(1).Activate: j = 72
    For i = 1 To UBound(a, 1) Step 1
        Set x = [C:C].Find(what:=a(i, 1), LookAt:=xlWhole)
        If Not x Is Nothing Then
            fst = x.Address
            Do
                Cells(x.Row, j) = a(i, 2)
                Set x = [C:C].FindNext(x)
            Loop While fst <> x.Address
        Else
            k = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(k, 3) = a(i, 1): Cells(k, j) = a(i, 2)
        End If
    Next
End Sub
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 28.01.2011, 10:06   #4
pechenushka_xxx
 
Регистрация: 28.01.2011
Сообщений: 3
По умолчанию

Большое спасибо, все получилось)))))
pechenushka_xxx вне форума Ответить с цитированием
Старый 28.01.2011, 10:19   #5
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Примерно такой же код (принцип поиска) использую в универсальном (платном после 15 раза) http://hugo.nxt.ru/CompareFiles.Find.rar
Только добавил настроек в диалоге и ещё немного другой функциональности.
Для этой задачи:
Файл - приёмник: C:\temp\pechenushka_xxx\expertiza1. xls
Файл - источник: C:\temp\pechenushka_xxx\Справочник ЛПУ.xls
Столбцы сравнения в приёмнике: c
Столбцы сравнения в источнике: a
Лист - приёмник (№): 1
Лист - источник (№): 1
Столбцы - приёмники данных копирования: bt
Столбцы - источники данных копирования: b

Кстати, не все коды нашлись.
И обнаружился один косяк в Ваших данных -
результат работы этих двух макросов почти одинаков - расхождение по коду 1022800530807
мой код взял первое совпадение, код SAS888 последнее:

филиал ОГУЗ "Амурский областной КВД" в г. Свободный
и
ОГУЗ"АОКВД""
webmoney: E265281470651 Z422237915069 R418926282008

Последний раз редактировалось Hugo121; 28.01.2011 в 10:29.
Hugo121 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сравнение двух столбцов в разных книгах LAnLorD Microsoft Office Excel 132 17.05.2022 08:16
Сводная таблица разных ячеек из разных файлов vik74 Microsoft Office Excel 2 23.01.2011 20:53
Сравнение столбцов в разных книгах evdss Microsoft Office Excel 0 17.01.2011 09:45
Перемножение 2х ячеек из разных таблиц MichaelL Microsoft Office Access 1 29.09.2010 12:11
Вычитание полей с разных таблиц! RSmile Microsoft Office Access 6 25.04.2010 13:54