Получить результат из XLS и DBF
От: point_212 Россия  
Дата: 06.10.06 15:47
Оценка:
Подкинули тут бухи задачку....

В общем есть таблица в экселе, которую надо заполнить значениями и в таком виде отослать по мылу.
Есть еще произвольное количество DBF из которых надо эту таблицу заполнять.

Поскольку сделать надо было быстро (в идеале сегодня), я просто открыл эти таблицы (к моему удивлению не в Access, а в Excel) и написал макрос, который производит нужные преобразования. Но из-за моей тупости алгоритм там дуболомный — в цикле перебирает все... в общем работает крайне медленно.


У меня к вам, два вопроса:
1) Как можно написать все это подругому? То есть я понимаю что все это прекрасно можно сделать через SQL (по меньшей мере выбрать данные из таблиц DBF). Но вот знаний не хватает.... ни один язык программирования я сейчас не знаю в достаточной мере чтобы написать на нем быстро, то что нужно. Только вот дуратский VBA.... (и то хреново). В общем как все это можно реализовать?
ЗЫ Из языков, которые я когда-то изучал и более-менее помню: Perl, Python, Basic/VB, Pascal/Delphi...

2) Может можно просто менее дубовый алгоритм написать? Не подскажите как?

В экселевской книге (в данный момент) просто 6 листов. 1й — отладочный
2й — тот самый отчет
остальные — загруженные DBFки

Вот собственно сам дубовый алгоритм

Private Sub CommandButton1_Click()

    'Основной цикл перебирает все отчеты по остаткам из аптек, доступные нам (Лист2...ЛистN)
    SummaryReport = 2 'Номер листа с реузльтатом
    FirstReport = 3 'Номер листа с которого начинается первая таблица с данными
    
    'Константы. Номер столбцов с соотв. данными.
    tKOD_LEK_SRVA = 14
    rKOD_LEK_SRVA = 5
    
    rSERIA = 14
    tSERIA = 24
    
    rKOD_CENI = 6
    tKOD_CENI = 13
    
    tKOL_OSTATKA = 26
    rKOL_OSTATKA = 16
    
    tCENA_PREPARATA = 27
    rCENA_PREPARATA = 17
    rCENA_PREPARATA1 = 18
    
    tSUMMA_OSTATKA = 28
    rSUMMA_OSTATKA = 20
    
    
    
    
        rCurrLine = 23 'Текущая строка с данными в каждой таблице. Начинаем со 23й
        'пробегаем по всей таблице с данными. для каждого элемента
        Do While Sheets(SummaryReport).Cells(rCurrLine, rKOD_LEK_SRVA) <> "" 'пока в 5 колонке (код лек. ср-ва) текущей таблицы не пусто
            tCurrLine = 2 'Текущая строка в таблице с отчетом. Начинаем с 2й
            For CurrentDatabase = FirstReport To Sheets.Count 'с первого до последнего листа с данными
            'пробегаем по всему отчету. для каждого элемента
                Do While Sheets(CurrentDatabase).Cells(tCurrLine, tKOD_LEK_SRVA) <> ""  'пока в 14 колонке (код. лек. ср-ва) отчета таблицы не пусто
                    If Sheets(SummaryReport).Cells(rCurrLine, rKOD_LEK_SRVA) = Sheets(CurrentDatabase).Cells(tCurrLine, tKOD_LEK_SRVA) And _
                       Sheets(SummaryReport).Cells(rCurrLine, rSERIA) = Sheets(CurrentDatabase).Cells(tCurrLine, tSERIA) And _
                       Sheets(SummaryReport).Cells(rCurrLine, rKOD_CENI) = Sheets(CurrentDatabase).Cells(tCurrLine, tKOD_CENI) _
                    Then 'если код названия лекарства в обоих ячейках одинаков
                         'и серия одинакова
                        'и код цены одинаков
                        Sheets(SummaryReport).Cells(rCurrLine, rKOL_OSTATKA) = Sheets(SummaryReport).Cells(rCurrLine, rKOL_OSTATKA) + Sheets(CurrentDatabase).Cells(tCurrLine, tKOL_OSTATKA) 'добавляем в отчет остаток по конкретному препарату из выбранной таблицы
                        Sheets(SummaryReport).Cells(rCurrLine, rCENA_PREPARATA) = Sheets(SummaryReport).Cells(rCurrLine, rCENA_PREPARATA) + Sheets(CurrentDatabase).Cells(tCurrLine, tCENA_PREPARATA) '---//--- цену
                        Sheets(SummaryReport).Cells(rCurrLine, rSUMMA_OSTATKA) = Sheets(SummaryReport).Cells(rCurrLine, rSUMMA_OSTATKA) + Sheets(CurrentDatabase).Cells(tCurrLine, tSUMMA_OSTATKA) '---//--- сумму
    '////Выводим инфу о найденных совпадениях... чтобы не думать что прога зависла
                        TextBox1 = CurrentDatabase
                        TextBox2 = tCurrLine
                        TextBox3 = rCurrLine
                        Label4 = Sheets(SummaryReport).Cells(rCurrLine, 8)
                        UserForm1.Repaint
                        UserForm1.Repaint
                        UserForm1.Repaint
    '////
                    End If
                    tCurrLine = tCurrLine + 1 'к следующей строке таблицы с данными (след. препарат)
                Loop
            Next 'теперь обработаем следующую таблицу
            rCurrLine = rCurrLine + 1 'к следующей строке отчета (след. препарат)

            UserForm1.Repaint
        Loop

    MsgBox ("Пересчет закончен!")
End Sub
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.