| ← Апрель 2004 → | ||||||
|
1
|
2
|
3
|
4
|
|||
|---|---|---|---|---|---|---|
|
5
|
6
|
7
|
8
|
9
|
10
|
11
|
|
12
|
13
|
14
|
16
|
17
|
||
|
19
|
20
|
21
|
22
|
23
|
24
|
|
|
28
|
29
|
30
|
||||
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://prog.rusfaq.ru/basic
Открыта:
14-03-2002
Статистика
0 за неделю
RusFAQ.ru: Программирование на Basic / VBA
| Информационный Канал Subscribe.Ru |
RusFAQ.ru: Программирование на Basic / VBA
Выпуск № 100
от 18.04.2004, 09:00
| Администратор: Имя: Калашников О.А. URL: Информационный ресурс ICQ: 68951340 Россия, Москва |
О рассылке: Задано вопросов: 209 Отправлено ответов: 179 Активность: 85.64 %
|
| Список экспертов, ответы которых опубликованы в данном выпуске |
| Puma Статус: Опытный Общий рейтинг: 103.2 [Подробней >>] |
| Краткий перечень вопросов |
Вопрос № 207. Организация массива из файла. --- Здравствуйте, Уважаемые Эксперты. Обращаюсь к Вам со следующим воп... (ответов: 1)
Вопросов: 1, ответов: 1
| Вопрос № 207 |
Организация массива из файла.
---
Здравствуйте, Уважаемые Эксперты.
Обращаюсь к Вам со следующим вопросом.
Мне нужно органивать массив из данных, находящихся в файле.
Структура файла представляет собой:
номер1,ФИО1,группа1,специальность1,средний бал 1
номер2,ФИО2,группа2,специальность2,средний бал 2
номер3,ФИО3,группа3,специальность3,средний бал 3
и т.д.
Данные одного типа нужно вывести в одном listbox, данные следующего типа, в другом listbox\'e и т.д. Это нужно для того чтобы потом можно было сортировать по фамилии, например. Вот такая вот задача. Никак не могу справиться.
Буду благодарен за любую помощь
Приложение:
Вопрос отправлен: 15.04.2004, 08:54
Отправитель: Василий (vs_2k4@mail.ru)
[Следующий вопрос >>] [Список вопросов]
Отвечает Puma
Здравствуйте, Василий!
Загнать бы это в БД и не мучаться. Но раз нет, то пишем.
Вначале необходимо каждую строку из файла записать в элемент массива.
Чтобы выделить нужную подстроку (по номеру) используем функцию:
'Получение подстроки из строки
'Пример: Debug.Print GetSubString ("12#10#14#,"#",2) выдаст 10
Public Function GetSubString(ByVal Source As String, Delimeter As String, Num As Long) As String
Dim i As Long
Dim P1 As Long
If Num < 0 Then
GetSubString = vbNullString
Exit Function
End If
If Num = 0 Then
GetSubString = Source
Exit Function
End If
P1 = 0
P2 = 0
P11 = 0
If Len(Delimeter) > 1 Then Source = Translate(Source, Delimeter, Left$(Delimeter, 1))
GetSubString = vbNullString
P1 = InStr(Source, Delimeter)
If P1 > 0 Then
If Num = 1 Then
GetSubString = Mid$(Source, 1, P1 - 1)
P11 = P1
Else
'Найти левый обрамляющий символ
i = 1
Do While ((i <= Num - 1) And (P1 > 0))
P1 = InStr(Source, Delimeter)
If P1 > 0 Then Source = Mid$(Source, P1 + 1)
P11 = P11 + P1
i = i + 1
Loop
If P1 > 0 Then
'Найти правый обрамляющий символ
P2 = InStr(Source, Delimeter)
If P2 > 0 Then Source = Mid$(Source, 1, P2 - 1)
If Len(Source) > 0 Then
GetSubString = Source
Else
GetSubString = vbNullString
End If
Else
GetSubString = vbNullString
End If
End If
Else
If Num = 1 Then
GetSubString = Source
Else
GetSubString = vbNullString
End If
End If
End Function
Для сортировки используем функцию:
Sub QuickSort(varArray As Variant, _
Optional intLeft As Integer = Missing, _
Optional intRight As Integer = Missing)
' Entry point for sorting the array.
' This technique uses the recursive Quicksort
' algorithm to perform its sort.
Dim i As Integer
Dim J As Integer
Dim varTestVal As Variant
Dim intMid As Integer
If intLeft = Missing Then intLeft = LBound(varArray)
If intRight = Missing Then intRight = UBound(varArray)
If intLeft < intRight Then
intMid = (intLeft + intRight) 2
varTestVal = varArray(intMid)
i = intLeft
J = intRight
Do
Do While varArray(i) < varTestVal
i = i + 1
Loop
Do While varArray(J) > varTestVal
J = J - 1
Loop
If i <= J Then
SwapElements varArray, i, J
i = i + 1
J = J - 1
End If
Loop Until i > J
' To optimize the sort, always sort the
' smallest segment first.
If J <= intMid Then
Call QuickSort(varArray, intLeft, J)
Call QuickSort(varArray, i, intRight)
Else
Call QuickSort(varArray, i, intRight)
Call QuickSort(varArray, intLeft, J)
End If
End If
End Sub
Private Sub SwapElements(varItems As Variant, intItem1 As Integer, intItem2 As Integer)
Dim varTemp As Variant
varTemp = varItems(intItem2)
varItems(intItem2) = varItems(intItem1)
varItems(intItem1) = varTemp
End Sub
Эту функцию надо немного изменить чтобы можно было работать с подстроками, т.е. чтобы можно было сортировать массив,например, по второй подстроке (для этого надо использовать первую функцию для работы с подстроками)
Далее поиск, также надо модифицировать для работы с подстроками
Function BinarySearch(varItems As Variant, varSought As Variant) As Integer
' Simple Binary search.
' Given an array, and an item to find, return either
' the position of the item within the array, or
' -1 to indicate failure. If the item appears
' more than once in the array, it's not determined
' which occurrence this code will find.
Dim intLower As Integer
Dim intMiddle As Integer
Dim intUpper As Integer
intLower = LBound(varItems)
intUpper = UBound(varItems)
Do While intLower < intUpper
' Increase lower and decrease upper boundary,
' keeping varSought in range, if it's there at all.
intMiddle = (intLower + intUpper) 2
If varSought > varItems(intMiddle) Then
intLower = intMiddle + 1
Else
intUpper = intMiddle
End If
Loop
If varItems(intLower) = varSought Then
BinarySearch = intLower
Else
BinarySearch = -1
End If
End Function
Сам я такими вещами не занимался, но использую эти 3 функции, я думаю можно получить желаемый результат
Ответ отправлен: 16.04.2004, 00:30
Отправитель: Puma
|
Форма отправки вопроса |
Мы рекомендуем открывать рассылку в программе Internet Explorer 5.0+ или отправлять вопросы с сайта по адресу: http://rusfaq.ru/cgi-bin/Message.cgi.
(C) 2002-2003 Команда RusFAQ.ru.
| Вопрос и дополнение |
Ваш вопрос:
Приложение (если необходимо):
Получить ответов:
| Выбор рассылки |
| Программисту Assembler (22) C / C++ (13) Perl (1) Builder / Delphi (18) Pascal (18) Basic / VBA (2) Java / JavaScript (3) PHP (9) Криптография (6) WinAPI (11) Радиоэлектроника (6) |
Пользователю Windows 95/98/Me (34) Windows NT/2000/XP (46) "Железо" (25) Поиск информации (16) |
Администратору Windows NT/2000/XP (23) Linux / Unix (7) |
Юристу Гражданское право (10) Семейное право (8) Трудовое право (8) КоАП (6) |
Отправить вопрос всем экспертам выбранной рассылки.
Проект экспертов RusFAQ.ru | Фотоальбом | Virus.RusFAQ.ru | Администрирование
Профессиональная WEB-Студия B.I.T.
| http://subscribe.ru/
E-mail: ask@subscribe.ru |
Отписаться
Убрать рекламу |
| В избранное | ||
