Excel Macro WindCheck
Revision as of 10:39, 17 July 2019 by 172.18.0.1 (talk) (Created page with "<pre> Option Explicit Private Sub windcheck_stddev() Dim inputrow As Long Dim outputrow As Long Dim datecol As Integer Dim outcol As Integer Dim stddevwd...")
Option Explicit Private Sub windcheck_stddev() Dim inputrow As Long Dim outputrow As Long Dim datecol As Integer Dim outcol As Integer Dim stddevwd inputrow = 5 outputrow = 5 datecol = 1 outcol = 4 Do While Worksheets(1).Cells(inputrow, datecol).Value <> "" stddevwd = Worksheets(1).Cells(inputrow, datecol + 1).Value If stddevwd < 2 Then Worksheets(1).Cells(outputrow, outcol).Value = Worksheets(1).Cells(inputrow, datecol).Value Worksheets(1).Cells(outputrow, outcol + 1).Value = 6999 outputrow = outputrow + 1 End If inputrow = inputrow + 1 Loop End Sub Private Sub windcheck_WD_Skookum() Dim inputrow As Long Dim outputrow As Long Dim datecol As Integer Dim outcol As Integer Dim wind_prev1 Dim wind_prev2 Dim wind_cur Dim monthz inputrow = 7 outputrow = 5 datecol = 1 outcol = 4 Do While Worksheets(1).Cells(inputrow, datecol).Value <> "" monthz = Format(Worksheets(1).Cells(inputrow, datecol).Value, "mm") If monthz <= 4 Or monthz >= 10 Then wind_prev2 = Worksheets(1).Cells(inputrow - 2, datecol + 1).Value wind_prev1 = Worksheets(1).Cells(inputrow - 1, datecol + 1).Value wind_cur = Worksheets(1).Cells(inputrow, datecol + 1).Value If wind_cur = wind_prev1 Then ' date Worksheets(1).Cells(outputrow, outcol).Value = Worksheets(1).Cells(inputrow - 2, datecol).Value ' nan Worksheets(1).Cells(outputrow, outcol + 1).Value = 6999 outputrow = outputrow + 1 End If End If inputrow = inputrow + 1 Loop End Sub Private Sub windcheck_WSSSS_Skookum() Dim inputrow As Long Dim outputrow As Long Dim datecol As Integer Dim outcol As Integer Dim wind_prev1 Dim wind_prev2 Dim wind_cur Dim monthz inputrow = 7 outputrow = 5 datecol = 1 outcol = 4 Do While Worksheets(1).Cells(inputrow, datecol).Value <> "" monthz = Format(Worksheets(1).Cells(inputrow, datecol).Value, "mm") If monthz <= 4 Or monthz >= 10 Then wind_prev1 = Worksheets(1).Cells(inputrow - 1, datecol + 1).Value wind_cur = Worksheets(1).Cells(inputrow, datecol + 1).Value If wind_cur < 0.4 Then ' date Worksheets(1).Cells(outputrow, outcol).Value = Worksheets(1).Cells(inputrow, datecol).Value ' nan Worksheets(1).Cells(outputrow, outcol + 1).Value = 6999 outputrow = outputrow + 1 End If End If inputrow = inputrow + 1 Loop End Sub