Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Помогите исправить ошибки. Нужно извлечь уникальные id (попытка сделать через м)  (Прочитано 6164 раз)
0 Пользователей и 1 Гость смотрят эту тему.
klaus
Участник

ua
Offline Offline

« : 15-10-2008 10:27 » 

Если кому не лень, то пожалуйста помогите.
Помогите исправить ошибки. Нужно извлечь уникальные id (попытка сделать через масивы)
То, с чем проблемы - здесь: http://garden.gov.ua/failo/bd.rar (292 КБ)
 В архиве 2 папки, они у меня лежат на С. В папке хлс/ - примеры файлов
на обработку. (это геоботаника - выходим на полянку, смотрим растения -
записываем их код, бал - номер этого описания записываем через "-", идем
на следующую полянку...). Итак, по примерам - 15.txt - это исходник,
открываю екселем - получается то, что в 15.xls - в идеале, его бы и
обрабатывать, но на всякий случай упростил его до того, что в файле
16.xls - отсюда надо выбрать все уникальные id и по этим id выбрать из
базы (екселевская таблица, находится в папке С:/bd/bd.xls) расшифровку).
В перспективе база будет расширятся и вдоль и вширь, поэтому жестко к
границам привязываться нельзя. А после всего мне по каждому столбцу еще
и статистику пощитать нужно - сколь% деревья, однолетники....но это уже
следующий нерешенный этап. В папке bd/ файл run.xls - в нем этот макрос
и записан - модуль 2
Отдельно код модуля приводить думаю нет смысла - слишком абстрактно.
« Последнее редактирование: 15-10-2008 11:24 от klaus » Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #1 : 15-10-2008 10:49 » 

в лом лезть и тянуть файло Улыбаюсь
расскажи в чем ошибка?
Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
klaus
Участник

ua
Offline Offline

« Ответ #2 : 15-10-2008 11:24 » 

Должно выбрать из файла уникальные ид, по ним из базы излечь записи - соответственно этим ид, и написать на лист.
В результате или выдает всего несколько записей, или все, но только по 4 колонкам, а в базе их >70
К примеру вот так: (код ниже - модификация того что в архиве) выводит результат только по 4 столбцам, и не уникальные записи выдает а все "скопом":
Код:
im MyPath As String 'Путь
    Dim MyFileName As String 'Название файл(ов) которые мы будем открывать
    Dim MyFileName_ As String 'Название файл(ов) которые мы будем открывать
    Dim ID() As Integer 'Массив ID которые по которым мы будет собирать данные
    Dim KolID As Integer 'Произвольное к-во ID?
    Dim KolCells As Integer 'Количество строчек по которым мы будет искать данные
    Dim KolRows As Integer 'Количество столбцов по которым мы будет искать данные
    Dim ICells As Integer, JCells As Integer, ICellsID ' Счетчикu для цикла
    Dim WorkMas() As String
    Dim MasStat() As Integer
    Dim Counter As Integer
    Counter = 0
    MyPath_ = "C:\bd\"
    MyPath = "C:\xls\"
    MyFile = Application.GetOpenFilename("(*.xls),*.xls")
    MyFileName = MyFile 'Пишем имя файла в ктором храняться ID
    Workbooks.Open(MyFileName).Activate 'Открываем нужную нам книгу
        With ActiveWorkbook.ActiveSheet
            KolCells = .Cells(1, 1).End(xlDown).Row
            KolID = KolCells
            ReDim ID(KolCells)
            For ICells = 1 To KolCells
                            ID(ICells) = .Cells(ICells, 1)
            'все что есть в первом столбце заносим в массив
            Next ICells
        End With
    ActiveWindow.Close 'Закрываем книгу
   
    MyFileName_ = "BD.xls" 'Пишем имя файла базы данных
    Workbooks.Open(MyPath_ & "\" & MyFileName_).Activate 'Открываем нужную нам книгу
        With ActiveWorkbook.ActiveSheet
            KolCells = .Cells(1, 1).End(xlDown).Row
            KolRows = .Cells(1, 1).End(xlToRight).Column
            ReDim WorkMas(KolCells, KolRows)
            For ICells = 1 To KolCells
                For ICellsID = 1 To KolID
                    If .Cells(ICells, 1) = ID(ICellsID) Then
                        Counter = Counter + 1
                        For JCells = 1 To KolRows
                            WorkMas(Counter, JCells) = .Cells(ICells, JCells)
                           
                        ' Если тут есть нужный нам ID то заносим его в память
                        Next JCells
                    End If
                Next ICellsID
            Next ICells
        End With
    ActiveWindow.Close 'Закрываем книгу
    ' Все что нам надо у нас есть в памяти=))
    'Все что есть выводим
    ReDim MasStat("3")
    For ICells = 1 To Counter
        For JCells = 1 To KolRows
           
            If WorkMas(ICells, JCells) = "Значение1" Then MasStat(1) = MasStat(1) + 1
            If WorkMas(ICells, JCells) = "Значение2" Then MasStat(2) = MasStat(2) + 1
            Cells(ICells, JCells) = WorkMas(ICells, JCells)
           
        Next JCells
    Next ICells
       
            End Sub
« Последнее редактирование: 15-10-2008 12:12 от klaus » Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines