Function Transf_BraunBlanquet(ByVal BB_Str As String) As String
'Transformation of Braun-Blanquet 'Artmächtigkeit' to percentage cover (similar to usage in TurboVeg or twinspan)
'The key value mapping can be altered depending on specific requirements
'This UDF is used in the UDF SumKum_BraunBlanquet(), which will apply the Transformation on a range of values and
'will sum the transformed percentages. This cumulative sum can be used to check if the Braun-Blanquet estimation for
'a vegetation layer is reasonable.
With CreateObject("Scripting.Dictionary")
'~~> first transfer your list in Dictionary
.Add "r", "0"
.Add "+", "0"
.Add "1", "1"
.Add "2m", "2"
.Add "2a", "10"
.Add "2b", "20"
.Add "3", "37,5"
.Add "4", "67,5"
.Add "5", "87,5"
If Len(BB_Str) = 0 Then
'~~> case: empty cell
Transf_BraunBlanquet = 0
Exit Function
End If
For Each elem In .keys
key = elem
If key = BB_Str Then
Transf_BraunBlanquet = .Item(elem) * 1
Exit Function
End If
Next elem
End With
End Function
Function SumKum_BraunBlanquet(Rng As Range) As Double
'See comments on Transf_BraunBlanquet() for explanations
Dim Sum As Double
Dim RngArr As Variant
RngArr = Application.Transpose(Rng) 'dumps range values to array
For Each elem In RngArr
Sum = Sum + Transf_BraunBlanquet(elem)
Next elem
SumKum_BraunBlanquet = Sum
End Function
14 Jul 2017
Excel VBA User Defined Function for Transformation of Braun-Blanquet Values to Precentages of Vegetation Cover
16 Dec 2016
VBA Macro to Export Data from Excel Spreadsheet to CSV
Resources: http://stackoverflow.com/questions/13496686/how-to-save-semi-colon-delimited-csv-file-using-vba
and: http://stackoverflow.com/questions/35655426/excel-vba-finding-recording-user-selection
and: http://stackoverflow.com/questions/35655426/excel-vba-finding-recording-user-selection
Sub Export_CSV()
'***************************************************************************************
'author: kay cichini
'date: 26102014
'update: 16122016
'purpose: export current spreadsheet to csv.file to the same file path as source file
'
' !!NOTE!! files with same name and path will be overwritten
'***************************************************************************************
Dim MyPath As String
Dim MyFileName As String
Dim WB1 As Workbook, WB2 As Workbook
Set WB1 = ActiveWorkbook
'(1) either used range in active sheet..
'ActiveWorkbook.ActiveSheet.UsedRange.Copy
'(2) or alternatively, user selected input range:
Dim rng As Range
Set rng = Application.InputBox("select cell range with changes", "Cells to be copied", Default:="Select Cell Range", Type:=8)
Application.ScreenUpdating = False
rng.Copy
Set WB2 = Application.Workbooks.Add(1)
WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
MyFileName = "CSV_Export_" & Format(Date, "ddmmyyyy")
FullPath = WB1.Path & "\" & MyFileName
Application.DisplayAlerts = False
If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & _
"Warning: Files in directory with same name will be overwritten!!", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
With WB2
.SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
.Close False
End With
Application.DisplayAlerts = True
End Sub
18 Oct 2016
Collect GPX-Files from Subdirectories and Convert to Single KML File
Reference: https://cran.r-project.org/web/packages/sp/vignettes/intro_sp.pdf
library(sp) library(rgdal) # here, m ygpx files reside in subdirectories.. setwd("D:/WEB/gardaweb") files <- dir(pattern="*.gpx$", recursive = T, include.dirs = T) # extract spatial lines spl <- lapply(files, function(x) {readOGR(x, "tracks")@lines[[1]]} ) str(spl) # apply ID to ID slot for latter merge with attribute data for(i in 1:length(spl)) {slot(spl[[i]], "ID") <- as.character(i)} tracksSL <- SpatialLines(spl, proj4string = CRS("+proj=longlat +datum=WGS84")) # view data summary(tracksSL) plot(tracksSL) # make dataframe for merging with spatial data names <- sub("[.]gpx$", "", basename(files)) df <- data.frame(names = names, row.names = sapply(slot(tracksSL, "lines"), function(x) slot(x, "ID"))) # spatial dataframe tracksSLDF <- SpatialLinesDataFrame(tracksSL, data = df) # write ressult to KML writeOGR(tracksSLDF, dsn="tracks_collection.kml", layer= "Wolfi_Garda_Tracks", driver="KML", dataset_options=c("NameField=names"))
Subscribe to:
Posts
(
Atom
)