www.ПЕРВЫЕ ШАГИ.ru :: Шаг 70 - Нефть, таблицы и как делать не надо

Вот такое письмо.

Добрый день Артем. 
Дело в том что с этими данными также нужно производить 
другие расчеты и представлять их геологам, в Access'e по 
моему это сделать будет немного проблематично да и неудобно 
для передачи. так что лучше наверное все же в Excel'e. Ну ты 
понял в чем именно суть проблемы да? еще раз повторюсь чтобы 
уж не было непоняток, а то может объяснил я не так. имеется таблица. 
1 столбец имя скважины, второй насыщение пропластка. 
Выглядит это следующим образом: 
1210k	Нефть
1210k	Нефть
1210k	НВ
1210k	Неясно
1231	Вода
1231	Вода
1231	Вода
1231	Вода
По скважине 1210к есть насыщение нефть, нв и неясно. соответственно тип 
скважины нефтенасыщенный 1231 только вода значит водо-насыщенная и т.д. 
в таком же духе. Вот. 
С уважением Рустам Сафиуллин
mailto: [email protected]

Первая мысль которая родилась у меня после этого письма послать все к черту вмеcте с автором. Это классическая задача баз данных. Любые расчеты и все такое можно решить с помощью того же ACCESS и намного проще. Кроме того большая часть кода ниже будет просто реализация стандартного SQL запроса. Кроме того, код подвержен ошибкам в данных ведь Нефт и Нефть не одно и тоже. Но мой опыт работы с геологами показывает что объяснять им что то бесполезно. Можно и на EXCEL сделать. Можно неправильно но можно. Итак таблица выгляди вот так.

Сначала нужно определить где начинаются и заканчиваться данные, это написано в "Шаг 45 - Начало и конец данных".

Dim allbore As Range ' здесь будет храниться диапазон скважин
' выбрать колонку
Set allbore = Range("A:A")
' только с данными
Set allbore = Range(allbore.Columns.End(xlUp).Address, allbore.Columns.End(xlDown).Address)
' выделить
allbore.Select

А вот результат:

Теперь нам нужно создать список скважин которые есть, способ один перебрать все записи и уникальные поместить у коллекцию. Как двигаться по диапазону написано в шаге "Шаг 66 - Движение по диапазону".

Dim borename As New Collection ' это набор скважин

Sub FindOil()
	Dim allbore As Range ' здесь будет храниться диапазон скважин
	Set allbore = Range("A:A") ' выбрать колонку
	' только с данными
	Set allbore = Range(allbore.Columns.End(xlUp).Address, allbore.Columns.End(xlDown).Address)
	allbore.Select 		 	' выделить
	For Each bore In allbore 	' бежим по диапазону скважин
	    bore.Select  		' выделяем ячейку
	    borename.Add (bore.Value)   ' добавить к коллекцию
	Next bore
End Sub

Вот теперь у нас в коллекции все имена скважин. Но они повторяться же. Надо при добавлении проверять есть такое имя в коллекции или нет. Напишем функцию.

Function FindElement(name As String) As Boolean
	' бежим по коллекции
	For Each elem In borename
		' если имя совпадает вернуть FALSE
		If elem = name Then
			FindElement = False
			Exit Function
		End If
	Next elem
	' нет имени
	FindElement = True
End Function

И применим ее:

Dim allbore As Range ' здесь будет храниться диапазон скважин

Sub FindOil()
	Set allbore = Range("A:A") ' выбрать колонку
	' только с данными
	Set allbore = Range(allbore.Columns.End(xlUp).Address, allbore.Columns.End(xlDown).Address)
	allbore.Select ' выделить
	For Each bore In allbore ' бежим по диапазону скважин
	    bore.Select  ' выделяем ячейку
	    If FindElement(bore.Value) = True Then
		' если скважины нет в коллекции
			borename.Add (bore.Value)   ' добавить к коллекцию
		End If
	Next bore
End Sub