Option Explicit

Public Const color_columncount As Integer = 14
Public Const lastcolumn = 37
Public Const column_lasdata_offset_x As Integer = 7
Public Const offset_x As Long = 1
Public Const offset_y As Long = 8
Public formationchange As Boolean
Public Const las_keywords As String = "DEPT,POR,SW,VCL,PERM,DEV,TVD"
Public Const maxrow As Long = 65536 'EXCEL Limit
Public lastrow As Long
Public str_address As String
Public Const shtMain As String = "LAS"
Public Const shtLayers As String = "Layers"
Public Const shtFormations As String = "Formations"
Public Const shtConfig As String = "Configuration"

Public Sub get_layerlist()

Dim layer_row As Long
Dim top_column As Integer
Dim read_offset_y As Integer
Dim sheetname_layers As String
Dim sheet_layers_offset_x As Integer
Dim sheet_layers_offset_y As Integer
Dim i As Long
Dim j As Long
Dim strAddress As String

strAddress = Selection.address 'store actual address
top_column = 18 'column which holds the top mdt values of layers/formations
read_offset_y = 6 'start row offset (searching for layertops)
sheet_layers_offset_x = 0
sheet_layers_offset_y = 2
j = 0
Application.ScreenUpdating = False

'drop old data
Sheets(shtLayers).Select
ActiveWorkbook.Sheets(shtLayers).Cells(1 + sheet_layers_offset_y, 1 + sheet_layers_offset_x).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Sheets(shtMain).Select
'/drop old data

lastrow = Sheets(shtConfig).Cells(1, 2)
ActiveWorkbook.Sheets(shtMain).Cells(read_offset_y + 1, top_column).Select

Do While Selection.Row < lastrow

Selection.End(xlDown).Select
If Selection.Row < maxrow Then

Selection.Offset(1, 0).Select 'layertop selected
layer_row = Selection.Row
With ActiveWorkbook.Sheets(shtLayers)
If Len(ActiveWorkbook.Sheets(shtMain).Cells(layer_row , 2)) > 0 Then
.Cells(1 + sheet_layers_offset_y + j, 1 + sheet_layers_offset_x).value = ActiveWorkbook.Sheets(1).Cells(layer_row, 2)
Else
Sheets(shtMain).Cells(Selection.Row, 2).Select
Selection.End(xlUp).Select
.Cells(1 + sheet_layers_offset_y + j, 1 + sheet_layers_offset_x).value = Selection
End If

.Cells(1 + sheet_layers_offset_y + j, 2 + sheet_layers_offset_x).value = Cells(layer_row, top_column).value 'top
.Cells(1 + sheet_layers_offset_y + j, 3 + sheet_layers_offset_x).value = Cells(layer_row, top_column + 1).value 'bottom
.Cells(1 + sheet_layers_offset_y + j, 5 + sheet_layers_offset_x).value = Cells(layer_row, column_lasdata_offset_x + 7).value 'dev
.Cells(1 + sheet_layers_offset_y + j, 4 + sheet_layers_offset_x).value = Cells(layer_row, column_lasdata_offset_x + 8).value 'tvd

For i = 3 To 20
'mdt tvt por sw vcl perm (gross, net & netpay figures)
.Cells(1 + sheet_layers_offset_y + j, i + 3 + sheet_layers_offset_x).value = Cells(layer_row, top_column + i - 1).value
Next i
End With

ActiveWorkbook.Sheets(shtMain).Cells(layer_row, top_column).Select 'selection wieder zurückstellen
j = j + 1 'next row

End If
Loop
Range(strAddress).Select
Application.ScreenUpdating = True

End Sub

Private Sub get_formationlist()

Dim formation_row As Long
Dim read_offset_y As Integer
Dim sheet_formations_offset_x As Integer
Dim sheet_formations_offset_y As Integer
Dim strAddress As String
Dim curFormation As String
Dim toprow As Long
Dim top As Single
Dim bottomrow As Long
Dim rowcount As Long

'cutoffs
Dim cut_por As Single
Dim cut_sw As Single
Dim cut_vcl As Single
Dim cut_perm As Single

'current values
Dim cur_por As Single
Dim cur_sw As Single
Dim cur_vcl As Single
Dim cur_perm As Single

'chunks
Dim n_chunksize As Integer
Dim n_chunk_toprow As Long
Dim n_chunk_bottomrow As Long
Dim n_first As Boolean
Dim prev_was_net As Boolean

Dim chunksize As Integer
Dim chunk_toprow As Long
Dim chunk_bottomrow As Long
Dim first As Boolean
Dim prev_was_netpay As Boolean


'gross
Dim g_rows As Integer
Dim g_por As Single
Dim g_por_sum As Single
Dim g_sw As Single
Dim g_sw_sum As Single
Dim g_vcl As Single
Dim g_vcl_sum As Single
Dim g_perm As Single
Dim g_perm_sum As Single

'net
Dim n_mdt As Single
Dim n_tvt As Single
Dim n_por As Single
Dim n_por_sum As Single
Dim n_por_num As Single
Dim n_por_den As Single
Dim n_sw As Single
Dim n_sw_sum As Single
Dim n_sw_num As Single
Dim n_sw_den As Single
Dim n_vcl As Single
Dim n_vcl_sum As Single
Dim n_vcl_num As Single
Dim n_vcl_den As Single
Dim n_perm As Single
Dim n_perm_sum As Single
Dim n_perm_num As Single
Dim n_perm_den As Single

'net pay
Dim np_mdt As Single
Dim np_tvt As Single
Dim np_por As Single
Dim np_por_sum As Single
Dim np_por_num As Single
Dim np_por_den As Single
Dim np_sw As Single
Dim np_sw_sum As Single
Dim np_sw_num As Single
Dim np_sw_den As Single
Dim np_vcl As Single
Dim np_vcl_sum As Single
Dim np_vcl_num As Single
Dim np_vcl_den As Single
Dim np_perm As Single
Dim np_perm_sum As Single
Dim np_perm_num As Single
Dim np_perm_den As Single

Dim c As Long
Dim i As Long
Dim j As Long

j = 0
c = 0
chunksize = 0
n_chunksize = 0
lastrow = Sheets(shtConfig).Cells(1, 2)
strAddress = Selection.address 'store actual address
read_offset_y = 6 'start row offset (searching for formationtops)
sheet_formations_offset_x = 0
sheet_formations_offset_y = 2
Application.ScreenUpdating = False

'drop old data
Sheets(shtFormations).Select
ActiveWorkbook.Sheets(shtFormations).Cells(1 + sheet_formations_offset_y, 1 + sheet_formations_offset_x).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Sheets(shtMain).Select
'/drop old data


Sheets(shtMain).Select
Cells(read_offset_y + 1, offset_x + 1).Select
Selection.End(xlDown).Select

Do While Selection.Row < lastrow

curFormation = Selection.value
toprow = Selection.Row
top = Cells(toprow, offset_x + column_lasdata_offset_x + 1)
Selection.End(xlDown).Select

If Selection.value = curFormation Then

'bottom found
bottomrow = Selection.Row + 1
rowcount = bottomrow - toprow + 1

cut_por = Cells(toprow, 1 + offset_x + column_lasdata_offset_x - 4)
cut_sw = Cells(toprow, 1 + offset_x + column_lasdata_offset_x - 3)
cut_vcl = Cells(toprow, 1 + offset_x + column_lasdata_offset_x - 2)
cut_perm = Cells(toprow, 1 + offset_x + column_lasdata_offset_x - 1)

With Sheets(shtFormations)
.Cells(1 + sheet_formations_offset_y + j, 1 + sheet_formations_offset_x).value = curFormation 'formationname
.Cells(1 + sheet_formations_offset_y + j, 2 + sheet_formations_offset_x).value = Cells(toprow, 1 + offset_x + column_lasdata_offset_x) 'top
.Cells(1 + sheet_formations_offset_y + j, 4 + sheet_formations_offset_x).value = cut_por 'por cut
.Cells(1 + sheet_formations_offset_y + j, 5 + sheet_formations_offset_x).value = cut_sw 'sw cut
.Cells(1 + sheet_formations_offset_y + j, 6 + sheet_formations_offset_x).value = cut_vcl 'vcl cut
.Cells(1 + sheet_formations_offset_y + j, 7 + sheet_formations_offset_x).value = cut_perm 'perm cut
.Cells(1 + sheet_formations_offset_y + j, 3 + sheet_formations_offset_x).value = Cells(bottomrow, 1 + offset_x + column_lasdata_offset_x) 'bottom
End With



blöablabalabalabal!!!!!!!!

des war sicha ned dabei :D

war zu lang... hab gute 3/4 davon weggelöscht und balbalababalbla hingeschrieben :D

Source Code für nen Pr0n-Filter Add-On?:D

if(k == 5)
{
alert("bla");
return "";
}

Neue Deepforces Single am Start ???? :D :D :D