Страницы: 1
RSS
Автоматическое заполнение ячеек с накапливающей базы данных
 
Добрый день!  
Не нашел подобный пример... Прошу помочь с заполнением данных для отчета. Пример прикреплен.
 
как мне кажется, нужно писать макросы на событие изменения ячеек листа
Живи и дай жить..
 
А кто-то сможет мне помочь с макросами?
 
Ребят. Либо ссылку на примерчик похожий дайте!? Пжалуста..
 
По первой таблице подсказали не плохой вариант:  
Ячейка: J12     Формула  (стиль A1):   =ЕСЛИ(ЕНД(ВПР($E12;DB;4;0));"";ВПР($E12;DB;4;0))  
                 Формула  (стиль R1C1): =ЕСЛИ(ЕНД(ВПР(RC5;DB;4;0));"";ВПР(RC5;DB;4;0))
 
ответил   
http://sizop.my1.ru/forum/10-851-1
Excel 2007
 
Супер. Спасибо!
 
Пока база небольшая - можно и так.  
Но когда будет пара тысяч - уже думаю почувствуете тормоза.  
А на словаре (как я на программерс упомянул) будет мнгновенно - только расход памяти побольше, за счёт запоминания номеров с их позицией на листе.  
Вопрос пополнения базы не вытанцовывается...
 
Предлагаю пополнять базу так - если номер не найден, то сразу ставим в определённый столбец метку. Это не мешает заполнять/править другие поля.  
Далее спецкодом по спецкоманде от например спецкнопки заносим все строки с метками в базу, метки стираем, словарь обновляем.  
При обновлении словаря дополнительно поверяем базу на случайные дубли, ну или это делаем при пополнении базы - найденным дублям переносим метку в колонку дублей. Позже с ними разбираемся отдельно мануально. Или не разбираемся - нехай лежат.  
Как Вам такой алгоритм?
 
А на примерчике можно посмотреть?) Потестить?
 
Хитро :)  
Сегодня не будет.
 
Ок)
 
Получилось так (файлы выкладывать не хочу, т.ч. вот код):  
 
в модуль книги:  
 
Private Sub Workbook_Open()  
   Dim a(), i&  
   Set oD = CreateObject("Scripting.Dictionary")  
   oD.CompareMode = vbTextCompare  
 
   a = Sheets("baza").Range("a3").CurrentRegion.Value  
   For i = 1 To UBound(a): oD.Item(a(i, 1)) = i: Next  
 
End Sub  
 
 
в модуль листа с телефонами:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   Dim t&, rr As Range  
   If Target.Cells.Count > 1 Then Exit Sub  
   If Target.Column = 5 Then  
       Application.EnableEvents = False  
       If oD.exists(Target.Value) Then  
           Set rr = Sheets("baza").Range("a3").CurrentRegion  
           t = oD.Item(Target.Value)  
           Target.Offset(, 3).Value = rr.Rows(t).Cells(2).Value  
           Target.Offset(, 4).Value = rr.Rows(t).Cells(3).Value  
           Target.Offset(, 5).Value = rr.Rows(t).Cells(4).Value  
       Else  
           Target.Offset(, 6).Value = "new"  
       End If  
       Application.EnableEvents = True  
   End If  
End Sub  
 
 
ну и в стандартный модуль объявление словаря и спецкод (его выполнять при активном листе с телефонами, ну или замените ActiveSheet на указание на лист) :  
 
Public oD As Object  
 
Sub speckod()  
   Dim cc As Range, rr As Range  
   For Each cc In ActiveSheet.UsedRange.Columns("K").Cells  
       If cc.Value = "new" Then  
           If oD.exists(cc.Offset(, -6).Value) Then  
               cc.Value = Empty  
               cc.Offset(, 1).Value = "double"  
           Else  
               Set rr = Sheets("baza").Range("a3").CurrentRegion  
               With rr.Rows(rr.Rows.Count).Offset(1)  
               .Cells(1) = cc.Offset(, -6).Value  
               .Cells(2) = cc.Offset(, -3).Value  
               .Cells(3) = cc.Offset(, -2).Value  
               .Cells(4) = cc.Offset(, -1).Value  
               End With  
               oD.Item(cc.Offset(, -6).Value) = rr.Rows.Count + 1  
               cc.Value = Empty  
           End If  
       End If  
   Next  
End Sub  
 
 
Этот спецкод запускать кнопкой когда хотите обновить базу, или допустим при переходе на любую ячейку столбца с телефонами, или может ещё что можно придумать.  
Я бы поставил на первую/вторую закреплённую вверху строку кнопку и жмакал её, когда готов пополнить базу. Сразу и файл сохранял (добавить в код этот функционал).  
Если какие-то записи в базу заносить не нужно - сотрите "new", и наоборот - если что-то из ранее записанного нужно добавить в базу - можно "new" дописать.  
Если телефонов за месяц уж очень много и For Each cc In ActiveSheet.UsedRange.Columns("K").Cells заметно тормозит - эту часть можно переписать на массивах, чтоб перебирал массив и лез на лист только к "new".  
Если база правится мануально - нужно выполнить "перезагрузку" словаря. Для этого можно или закрыть/открыть книгу, или продублировать в модуле код, который стоит на загрузке, или на загрузке поставить только вызов такого же кода, но из модуля.  
В общем, как-то так думаю...
 
<EM><FONT color=#99000><STRONG>[Здесь была полная цитата предыдущего сообщения]<STRONG></FONT> - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>  
 
Огромнейшее спасибо!)
 
Цитирование в данном случае ЗАЧЕМ?!!
 
для визуализации ОГРОМНЕЙШЕГО спасибо :)
Страницы: 1
Читают тему
Наверх