Каюсь, грешен. Комментарии просто ужасны, код на 99% сырой требует приведения в более качественный вид. Но ведь работает!
Макрос выводит на лист Excel статистику (имя скважины в файле, метод, начало записи, конец записи, минимальное значение, максимальное значение, код пустого значения, путь к файлу) по группе Las файлов
Sub open_file()
'Диалоговое окно открытия файлов.
'Имена файлов записываются в глобальную переменную Global fname() As String, а их количество в не менее глобальную t as integer
Dim metod() As String 'Имя метода, который будет вырезаться
Dim result As Integer 'Сначала отвечает за наличие вабранных файлов, а потом счётчик
Dim t As Integer
Dim l As String 'Директория
Dim log_n As Integer
Close
Application.ScreenUpdating = False
With Application.FileDialog(1) 'Если не ошибаюсь, то это "метод" для диалогового окна открытия файлов
.Title = "Выбирите файл" 'Заголовок окна
.InitialFileName = "D:\Work\Petrel11\LAS_MODIF" 'Адрес по умолчанию
.AllowMultiSelect = True 'Включена возможность выбора нескольких файлов
.Filters.Clear 'Очистка фильтра по расширенью
.Filters.Add "las файлы", "*.las", 1 'Добавление фильтра на расширение *.las
result = .Show 'ХЗ
t = .SelectedItems.Count - 1 'Запись количества выбранных файлов
If result = 0 Then Exit Sub 'Если ничего не выбрано, то выход из программы
Range("A1").Select
kkkk = 1
Range("A2:H" & Application.Rows.Count).ClearContents 'Очистка выходных строк
For result = 0 To t 'Цикл записи имён выбранных файлов в массив fname()
Call Las(Trim(.SelectedItems.Item(result + 1)), l, log_n, metod)
For i = 0 To UBound(metod, 2)
ActiveCell.Offset(i + kkkk, 0) = metod(0, i) 'Имя скважины
ActiveCell.Offset(i + kkkk, 1) = metod(1, i) 'Метод
ActiveCell.Offset(i + kkkk, 2) = metod(2, i) 'Начало записи
ActiveCell.Offset(i + kkkk, 3) = metod(3, i) 'Конец записи
ActiveCell.Offset(i + kkkk, 4) = metod(5, i) 'Min
ActiveCell.Offset(i + kkkk, 5) = metod(6, i) 'Max
ActiveCell.Offset(i + kkkk, 6) = metod(4, i) 'Null
ActiveCell.Offset(i + kkkk, 7) = Trim(.SelectedItems.Item(result + 1))
Next i
kkkk = kkkk + i
Next result
End With 'Конец метода
Close
MsgBox ("Исполнено!")
Application.ScreenUpdating = True
End Sub
Sub Las(name, l, log_n, ByRef metod)
'Кусок кода, который позвовяет вырезать из *.las файлов нужные зонды. В данной версии
'зондов два, но путём нехитрых манипуляций их число может стать произвольным.
'Как обычно интерфейс суров до безобразия, управление с помощью редактирования тела кода.
'Выходные файлы создаются в той же директории, где находятся *.las, имя файлов - префикс "prb"
'(буквы добавляются, чтобы MatLab воспринимал без лишних вопросов)+имя скважины из *.las
'Файлы содежат стлобцы: "dept" и заданные пользователем metod1/metod2
'Dim metod(50, 4) As String 'Имя метода, который будет вырезаться
'Dim metod2 As String 'Имя метода, который будет вырезаться
Dim dl1 As Byte 'Длина имени первого метода
Dim dl2 As Byte '->>- второго метода
Dim i As Integer 'Счётчик las-файлов
Dim numstl(50) As Integer 'Массив номеров столбцов глубин и методов
Dim Las As Integer 'Номер открываемого las-файла
Dim str As String 'Читаются строки из las-файла
Dim nUl(3) As Double 'Массив: 0 Null, 1 значение depth, 2 значение metod1, 3 значение metod2
Dim well As String 'Имя скважины
Dim weLLtmp As String 'Имя скважины
Dim NULLtmp As String 'Переменная, в которую посимвольно будет считываться Null
Dim shortSTR As String 'Преременная для поиска имён столбцов
Dim varNULL As Byte 'Положение символа в при чтении в заголовке, в общем, в коде более-менее понятно
Dim kui As Byte 'Переменная положения столбцов
Dim outPUTfile As String 'Полное имя выходного файла
Dim numOUT As Integer 'Номер выходного файла
Dim pluk As Byte 'Счётчик, отвечает за номер текущего столбца при чтении значений
Dim sRt As String 'Переменная для вывода значения глубины и методов в выходной файл
Dim poeben As Double 'Переменная, в которую читаются ЗНАЧЕНИЯ из .*las
Dim flag As Boolean
ReDim metod(6, 50)
'____________________
metod1 = "PS" '| Имена интересующих методов, должны в точности соответствовать названиям в *.las
metod2 = "GK" '|
'---------------------
dl1 = Len(metod1)
dl2 = Len(metod2)
numstl(0) = 0 'Обнуление переменной, отвечающей за положение записи градиент зонда. Необх. при открытии нескольких файлов, если отсутствуют значения "GZ3"
numstl(1) = 0
numstl(2) = 0
Las_n = FreeFile 'Присвоили свободный номер открываемому las-файлу
Open name For Input As Las_n 'Открыли las-файл
Do 'Цикл чтения шапки *.las
Line Input #Las_n, str
If Trim(Left(str, 2)) = "~W" Then 'Если строка начинается с ~W, бум считать, что это Well Information. Условие такое куцее, т.к. боюсь разного регистра букав.
Do
Line Input #Las_n, str
Loop While Trim(Left(str, 1)) = "#"
nUl(0) = 0
well = ""
NULLtmp = ""
weLLtmp = ""
Do 'Циииииииииииииккккккккккккккккккклллллллллллллллллллл чтения строк в "Data Type Information"
shortSTR = Trim(Left(str, 6)) 'Вырезал я первые десять символов, а то строки могут и с пробела начинаться, да и вообще пусть хрень будет маленькая
If Left(shortSTR, 4) = "NULL" Then 'Если первые четыре символа NULL, то, соответственно и читаем Null
varNULL = spa(str, 7) 'Пропуск пробелов до значения
Do
NULLtmp = NULLtmp & Mid(str, varNULL, 1) 'Посимвольное чтение до двоеточия
varNULL = varNULL + 1
Loop While Mid(str, varNULL, 1) <> ":"
nUl(0) = CDbl(NULLtmp) 'Запись в массив с преобразованием текстовой переменной в double
End If
If Left(shortSTR, 4) = "WELL" Then 'Если первые 4 символа WELL, то пробуем прочитать имя скважины
varNULL = spa(str, 7) 'Пропуск пробелов
Do
If Mid(str, varNULL, 1) Like ":" Then well = "No": Exit Do
well = well & Mid(str, varNULL, 1) 'Чтение символов до двоеточия
varNULL = varNULL + 1
Loop While Mid(str, varNULL, 1) <> ":"
well = Trim(well) 'Убрали пробелы
varNULL = varNULL + 1 'Пропустили двоеточие
Do
weLLtmp = weLLtmp & Mid(str, varNULL, 1) 'Чтение символов до конца строки
varNULL = varNULL + 1
Loop Until varNULL > Len(str)
weLLtmp = Trim(weLLtmp) 'Убрали пробелы
If well = "WELL" Then well = weLLtmp 'Вот, собственно, из-за чего имя скважины читается дважды? А всё потому, что в разных версиях, оно может быть в разных местах. На данной строке происходит выбор, что будет именем скважины
End If
Line Input #Las_n, str
Loop While nUl(0) = 0 Or well = "" 'Конец ццциииииииккккккллллллаааа, когда всё, что нам надо уже прочитано. Всё хорошо, только тут будет косяк, если в шапке не будет указанно имя скважины. Впрочем, *.las без имени никуда не приткнёшь.
ElseIf Left(str, 2) = "~C" Then 'А если строка начинается с ~C, то думаетм, что это Curve Information и ищем номера интересующих нас столбцов
Do
Line Input #Las_n, str
Loop While Trim(Left(str, 1)) = "#"
kui = 0 'Обнуление счётчика столбцов
Do 'Цикл чтения строк "API CODE CURVE DESCRIPTION" и запись номеров интересующих столбцов
metod(0, kui) = well
metod(1, kui) = read_met(str)
metod(4, kui) = nUl(0)
If metod(2, kui) Like "DEPT" Then numstl(0) = kui + 1
kui = kui + 1 'В итоге kui будет равняться количеству столбцов в *.las
shortSTR = Trim(Left(str, 10))
Line Input #Las_n, str
Loop While Left(str, 1) <> "~" And Left(str, 1) <> "#" And Trim(str) <> ""
yyy = Trim(str)
ReDim Preserve metod(6, kui - 1)
End If
If EOF(Las_n) = True Then
ReDim Preserve metod(6, 0)
metod(0, kui) = "Формат файла не поддерживается"
Exit Do
End If
Loop Until Left(str, 2) = "~A" Or EOF(Las_n) 'Шапка читается, пока не встретится "~A", что подразумевает "~ASCII Log Data", в версии 2.0 было написано кратко "~A"...
Do 'Цикл чтения *.las до конца
For pluk = 1 To kui 'Цикл чтения строк
If EOF(Las_n) = True Then Exit Do
Input #Las_n, poeben 'Последовательное чтение значений
If pluk - 1 = numstl(0) Then tmp_dept = poeben
If pluk <> numstl(0) And poeben <> nUl(0) And metod(2, pluk - 1) = "" Then metod(2, pluk - 1) = tmp_dept
If pluk <> numstl(0) And poeben <> nUl(0) Then metod(3, pluk - 1) = tmp_dept
If pluk <> numstl(0) And poeben <> nUl(0) And metod(6, pluk - 1) = "" Then metod(6, pluk - 1) = poeben
If pluk <> numstl(0) And poeben <> nUl(0) And poeben < metod(5, pluk - 1) Then metod(5, pluk - 1) = poeben
If pluk <> numstl(0) And poeben <> nUl(0) And poeben > metod(6, pluk - 1) Then metod(6, pluk - 1) = poeben
Next pluk
Loop Until EOF(Las_n) 'Цикл чтения *.las до конца
Close
End Sub
Function spa(ff, q) 'Функция счёта пробелов
Dim f As Byte 'ff имя текстовой переменной q начальное положение поиска пробела
f = 0 'spa выдаёт последнее положение пробела
Do
f = f + 1
Loop While Mid(ff, q + f, 1) = " "
spa = f + q
End Function
Function read_met(str) 'Функция чтения имени метода
Dim position As Byte
Dim spa_position As Byte
Dim tab_position As Byte
Dim point_position As Byte
Dim comma_position As Byte
str = Trim(str)
position = 255
spa_position = InStr(str, " ")
If spa_position <> 0 Then position = spa_position
tab_position = InStr(str, Chr(9))
If tab_position <> 0 And tab_position < position Then position = tab_position
point_position = InStr(str, Chr(46))
If point_position <> 0 And point_position < position Then position = point_position
comma_position = InStr(str, Chr(44))
If comma_position <> 0 And comma_position < position Then position = comma_position
read_met = Left(str, position - 1)
End Function
- участник сейчас на форуме
- участник вне форума
