Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Поиск по ФИО номер телефона
 
#1
29.10.2010 17:18:30
Парни, помогите пожалуйста! Номера не могу подцепить  
 
Даны ФИО на Листе2  
Дана телефонная база на Листе3  
 
Мой (кусок)кода:  
LastRow_ll = Sheets(3).UsedRange.Row - 1 + Sheets(3).UsedRange.Rows.Count  
If Sheets(3).Cells(r_l, 1) <> "" Then  
For r_ll = LastRow_ll To 1 Step -1  
If Replace(Sheets(3).Cells(r_ll, 2), " ", "") = Replace(Sheets(2).Cells(r_ll, 1), " ", "") Then  
k_X = Sheets(3).Cells(r_ll, 2)    
End If  
Next r_ll  
End If  
 
Replace делаю потому что бывает что лишние пробелы выставляют. Думал что уберу и они должны сравниться, а не фига. А может чего не так делаю? Будте добры, подскажите!
 
 
 
#2
29.10.2010 17:22:44
{quote}{login=russia}{date=29.10.2010 05:18}{thema=Поиск по ФИО номер телефона}{post}Replace делаю потому что бывает что лишние пробелы выставляют. {/post}{/quote} Так а может эти лишние пробелы предварительно привести к одному в самом списке ФИО, а потом уже производить поиск?
 
 
 
#3
29.10.2010 17:25:58
Вообще-то лишние пробелы обычно с помощью Application.Trim() убирают.
 
 
 
#4
29.10.2010 17:30:05
Не видя всего макроса могу предложить только вместо:  
If Replace(Sheets(3).Cells(r_ll, 2), " ", "") = Replace(Sheets(2).Cells(r_ll, 1), " ", "") Then  
If application.trim(Sheets(3).Cells(r_ll, 2)) = application.trim(Sheets(2).Cells(r_ll, 1)) Then  
application.trim  
Но это циклы. Я бы воспользовался Find.
Я сам - дурнее всякого примера! ...
 
 
 
#5
29.10.2010 17:30:09
Debug.Print UCase(Application.Trim(Sheets(3).Cells(r_ll, 1)))  
вот это и сравнивайте.
 
 
 
#6
29.10.2010 17:30:19
{quote}{login=}{date=29.10.2010 05:22}{thema=Re: Поиск по ФИО номер телефона}{post}{quote}{login=russia}{date=29.10.2010 05:18}{thema=Поиск по ФИО номер телефона}{post}Replace делаю потому что бывает что лишние пробелы выставляют. {/post}{/quote} Так а может эти лишние пробелы предварительно привести к одному в самом списке ФИО, а потом уже производить поиск?{/post}{/quote}  
Да и список этот на 1000 ФИО не я забиваю.  
Это два разных списка и делают два разных человека - человеческий фактор.  
Так вроде этим и привожу к одному:  
Replace(Sheets(3).Cells(r_ll, 2), " ", "") = Replace(Sheets(2).Cells(r_ll, 1), " ", "")
 
 
 
#7
29.10.2010 17:32:18
{quote}{login=Hugo}{date=29.10.2010 05:30}{thema=}{post}Debug.Print UCase(Application.Trim(Sheets(3).Cells(r_ll, 1)))  
вот это и сравнивайте.{/post}{/quote} Привет, Игорь. Мож, лучше Option compare text?
Я сам - дурнее всякого примера! ...
 
 
 
#8
29.10.2010 17:32:26
{quote}{login=KuklP}{date=29.10.2010 05:30}{thema=}{post}Я бы воспользовался Find.{/post}{/quote}  
 
Как это будет выглядить в коде?
 
 
 
#9
29.10.2010 17:33:46
Ну вообще-то да, вообще выкинуть пробелы надёжнее. Но и регистр надо к одному привести - в этом тоже есть разница.
 
 
 
#10
29.10.2010 17:34:59
Option compare text - наверно можно, но я как-то больше глазам доверяю :)
 
 
 
#11
29.10.2010 17:35:37
{quote}{login=Hugo}{date=29.10.2010 05:30}{thema=}{post}Debug.Print UCase(Application.Trim(Sheets(3).Cells(r_ll, 1)))  
вот это и сравнивайте.{/post}{/quote}  
 
Trim - убирает из конца строк. А там бывает что двойные пробелы внутри строки
 
 
 
#12
29.10.2010 17:36:42
{quote}{login=KuklP}{date=29.10.2010 05:30}{thema=}{post}Я бы воспользовался Find.{/post}{/quote}  
А я бы перебирал массивы :)  
Раз уж тут так неразберипоймёшь...
 
 
 
#13
29.10.2010 17:37:25
{quote}{login=russia}{date=29.10.2010 05:35}{thema=Re: }{post}{quote}{login=Hugo}{date=29.10.2010 05:30}{thema=}{post}Debug.Print UCase(Application.Trim(Sheets(3).Cells(r_ll, 1)))  
вот это и сравнивайте.{/post}{/quote}  
 
Trim - убирает из конца строк. А там бывает что двойные пробелы внутри строки{/post}{/quote}  
 
Секретное слово - Application.Trim
 
 
 
#14
29.10.2010 17:37:54
{quote}{login=Hugo}{date=29.10.2010 05:33}{thema=}{post}Ну вообще-то да, вообще выкинуть пробелы надёжнее. Но и регистр надо к одному привести - в этом тоже есть разница.{/post}{/quote}  
Хм... Об этом я даже и не подумал.  
 
Парни, с идеями Вы молодцы. Но можно Ваши идеи в коде прописать. Я ж только начинаю и многого не знаю.
 
 
 
#15
29.10.2010 17:42:10
With Worksheets(3).Range("a1:a500")  
Set c = .Find(Sheets(2).Cells(r_ll, 1), lookin:=xlValues)  
End With  
Но перед этим привести все записи к единому образцу.
Я сам - дурнее всякого примера! ...
 
 
 
#16
29.10.2010 23:58:48
Стопорится на это строке :(  
If UCase(Sheets(2).Cells(r_l, 2).Value) = UCase(Sheets(3).Cells(r_ll, 2).Value)  
пробовал и так  
If UCase(Sheets(2).Cells(r_l, 2)) = UCase(Sheets(3).Cells(r_ll, 2))  
 
Выходит ошибка:  
Run-time '13' error: Type mismatch  
//  
Не соответствие типов. Как решить эту проблему?
 
 
 
#17
30.10.2010 00:01:34
{quote}{login=Hugo}{date=29.10.2010 05:36}{thema=Re: }{post}{quote}{login=KuklP}{date=29.10.2010 05:30}{thema=}{post}Я бы воспользовался Find.{/post}{/quote}  
А я бы перебирал массивы :)  
Раз уж тут так неразберипоймёшь...{/post}{/quote}  
Подредактировал бы твой код который ты мне писал до этого на массивах. Но пока времени нет разбираться в них (сразу не получилось разобраться)
 
 
 
#18
30.10.2010 00:05:25
{quote}{login=russia}{date=29.10.2010 11:58}{thema=to Hugo:}{post}  
Не соответствие типов. Как решить эту проблему?...{/post}{/quote}  
... предварительно убрал лишние пробелы  
 
For  
with sheets(2) ' и 3-ий лист тоже сделал, проверил - нет лишних пробелов  
.Cell(r, 2).Value = Application.Trim(.Cell(r, 2).Value)  
Next
 
 
 
#19
30.10.2010 00:20:39
Посмотрите такой вариант:  
Абонент выбирается из списка в ячейке А2
 
 
 
#20
30.10.2010 00:28:50
{quote}{login=Kuzmich}{date=30.10.2010 12:20}{thema=Выбор}{post}Посмотрите такой вариант:  
Абонент выбирается из списка в ячейке А2{/post}{/quote}  
Спасибо, за отзыв. Но вариант не подойдет.  
 
Суть в том чтобы код нашел человека (взяв ФИО на втором листе и найдя эту фамилию на третьем - телбазе, и выставила его телефоны) и закинул значение в указанную ячейку на первой странице.
 
 
 
#21
30.10.2010 00:49:19
А может быть по старинке: формулами,именоваными диапазонами и выпадающим списком?  
С уважением, Александр.
 
 
 
#22
30.10.2010 01:02:52
Прощу прощения.  
Прицепил не тот файл.  
С уважением, Александр.
 
 
 
#23
30.10.2010 01:32:49
{quote}{login=russia}{date=30.10.2010 12:01}{thema=Re: }{post}    
Подредактировал бы твой код который ты мне писал до этого на массивах. Но пока времени нет разбираться в них (сразу не получилось разобраться){/post}{/quote}  
То, что писал - уже не помню, извини. Так что код вероятно другой. Но принцип похож.    
Не понял про " закинул значение в указанную ячейку на первой странице", поэтому выгружаю всё найденное (для теста одну фамилию отключил.
 
 
 
#24
30.10.2010 05:34:58
Чуть измененный код Игоря.
Я сам - дурнее всякого примера! ...
 
 
 
#25
30.10.2010 12:40:04
{quote}{login=Hugo}{date=30.10.2010 01:32}{thema=Re: Re: }{post}  
Не понял про " закинул значение в указанную ячейку на первой странице", поэтому выгружаю всё найденное (для теста одну фамилию отключил.{/post}{/quote}  
Немного "подковырял" для своих нужд.  
   Dim a(), b(), iv As Long, ii As Long, iii As Long  
   'первый массив  
   With Sheets(2)  
       a = .Range("b1:b" & .Range("B" & Rows.Count).End(xlUp).Row).Value  
   End With  
   'второй массив  
   With Sheets(3)  
       b = .Range("a1:e" & .Range("A" & Rows.Count).End(xlUp).Row).Value  
   End With  
   'третий массив для результатов  
   ReDim c(1 To UBound(a), 1 To 5)  
     
   'перебираем массивы  
   For iv = 1 To UBound(a)  
       For ii = 1 To UBound(b)  
           'сравниваем фамилии  
           If a(iv, 1) = b(ii, 1) Then  
               'копируем фамилии и телефоны  
               iii = iii + 1  
               c(iii, 1) = b(ii, 1) 'ФИО  
               c(iii, 2) = b(ii, 2) 'Должность  
               c(iii, 3) = b(ii, 3) 'рабочий телефон  
               c(iii, 4) = b(ii, 4) 'сотовый телефон  
               c(iii, 5) = b(ii, 5) 'домашний телефон  
           End If  
       Next ii, iv  
 
ThisWorkbook.Sheets(2).[bb1].Resize(iii, 5).Value = c 'выгружаем результат
 
Игорь(?), примного благодарен за твою работу и что расписал, что к чёму! Постараюсь не остаться в долгу.
 
 
 
#26
30.10.2010 12:44:38
"Run-time '13' error: Type mismatch"  
На работе нормально всё работало, а дома затыкалось. Уже хотел на работу ехать. Я конечно догадывался что разница в разных версиях экселя, но как-то не догадывался, что можно пересохранить в формате .xls (было .xlsx)
 
 
 
#27
30.10.2010 12:56:16
Вариант Сергея чуть правильнее и быстрее (Трим сразу всему диапазону и опция сравнения), но если делать как я сперва написал, то можно вместо трима действительно выкинуть все пробелы вообще. Или добавить перебор имён/фамилий/отчеств в обоих сравниваемых ячейках - т.е иванов иван иванович = Иван Иванович Иванов. Будет помедленнее, но зато и мышь не проскользнёт.  
Сразу говорю - алгоритма такой проверки у меня нет, если надо - надо думать.  
И да - Игорь :)
 
 
 
#28
30.10.2010 13:09:32
{quote}{login=Hugo}{date=30.10.2010 12:56}{thema=}{post}Вариант Сергея чуть правильнее и быстрее (Трим сразу всему диапазону и опция сравнения), но если делать как я сперва написал, то можно вместо трима действительно выкинуть все пробелы вообще. Или добавить перебор имён/фамилий/отчеств в обоих сравниваемых ячейках - т.е иванов иван иванович = Иван Иванович Иванов. Будет помедленнее, но зато и мышь не проскользнёт.  
Сразу говорю - алгоритма такой проверки у меня нет, если надо - надо думать.  
И да - Игорь :){/post}{/quote}  
Нее... всё четко работает! Ap.Trim сделал сразу после загрузки книг - как и советовали. UCase использую когда сравниваю, скорость уменьшается 2-3 раза, но так будет лучше :)  
Спасибо! Мышь одна есть. Пустые ячейки на обоих листах. Блин почему то цикл удаляет их не чётко - с какой-то долей вероятности(когда большой диапазон перебирает), поэтому везде стараюсь прописать thisworkbook.sheets, да и с with возникали проблемы. Может на финише аккуратненько в коде и добавлю with.  
Тоже самое, что и с пустыми, было когда цикл по удалению строчек содержащих "ФИО" - пропускал. Решил тем что добавил в цикл удаления по цветам (эта строчка синькой везде подкрашена) - цикл удаления по цветам четко работает.
 
 
 
#29
30.10.2010 13:47:24
Что за проблема с пустыми?  
If a(iv, 1) <> "" Then  
и дальше сравнение.  
Пустые отсеются.
 
 
 
#30
30.10.2010 14:32:22
Вот тот код который ты мне скидывал - он больше подходит.  
Потому что тот что ты мне дал сейчас код скидывает список = равный по строчкам.  
Например нет ФИО в том или в другом списке, а он делает его единым списком без пробелов - получается сортировка согласно второму листу, но строчки фамилий не соотвествуют.  
//  
Али-лу-я!!!  
//  
Сообразил чего мне нужно подправить :)  
 
'первый массив  
   With Sheets(2)  
       a = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value  
   End With  
   'второй массив  
   With Sheets(3)  
       b = .Range("A1:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value  
   End With  
   'третий массив для результатов  
   ReDim c(1 To UBound(a), 1 To 5)  
     
   'перебираем массивы  
   For iv = 1 To UBound(a)  
       For ii = 1 To UBound(b)  
           'сравниваем фамилии  
           If UCase(a(iv, 1)) = UCase(b(ii, 1)) Then  
               'копируем фамилии и телефоны  
               c(iv, 1) = a(iv, 1) 'ФИО  
               c(iv, 2) = b(ii, 2) 'Должность  
               c(iv, 3) = b(ii, 3) 'рабочий телефон  
               c(iv, 4) = b(ii, 4) 'сотовый телефон  
               c(iv, 5) = b(ii, 5) 'домашний телефон  
           End If  
       Next ii, iv  
ThisWorkbook.Sheets(2).[bb1].Resize(iv, 5).Value = c 'выгружаем результат
 
 
 
Страницы: 1 2 След.
Читают тему
Loading...