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
theBioBucket*
*a biologist's recycle-bin
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
)