Excel Macro Cheap Windrose
Revision as of 10:38, 17 July 2019 by 172.18.0.1 (talk) (Created page with "<pre> Option Explicit Public Sub winddirectionbinning() Dim inputcol As Integer Dim outcol As Integer Dim inputworksheetz As Integer Dim startrow As Long...")
Option Explicit
Public Sub winddirectionbinning()
Dim inputcol As Integer
Dim outcol As Integer
Dim inputworksheetz As Integer
Dim startrow As Long
Dim outputdate As Boolean
Dim columnincr As Integer
Dim startcol As Integer
Dim row As Long
Dim yearz
Dim monthz
Dim WR(0 To 16, 0 To 11), i, j
Dim summmm
Dim inWScol
Dim inWDcol
Dim datecol As Integer
Dim thiswindspeed, thiswinddirec
Dim hdirection, hwindspeed
Dim calm
For i = 0 To 16
For j = 0 To 11
WR(i, j) = 0
Next
Next
' get current wind velocity and direction
' stuff that should be set just initially
datecol = 1
inputworksheetz = 1
row = 5
inputcol = startcol
inWScol = 2
inWDcol = 3
outcol = 10
outputdate = True
summmm = 0
Do While Worksheets(inputworksheetz).Cells(row, datecol).Value <> ""
monthz = Format(Worksheets(inputworksheetz).Cells(row, datecol).Value, "mm")
thiswinddirec = Worksheets(1).Cells(row, inWDcol).Value
thiswindspeed = Worksheets(1).Cells(row, inWScol).Value
If monthz >= 6 And monthz <= 8 Then
If Abs(thiswinddirec) < 361 And Abs(thiswindspeed) < 50 Then ' the units here are degrees
Select Case thiswinddirec
Case 0 To 22.5 ' 0 to 22.5 degrees
hdirection = 1
Case 22.5 To 45 ' 22.5 to 45 degrees
hdirection = 2
Case 45 To 67.5 ' 45 to 67.5 degrees
hdirection = 3
Case 67.5 To 90 ' etc.
hdirection = 4
Case 90 To 112.5
hdirection = 5
Case 112.5 To 135
hdirection = 6
Case 135 To 157.5
hdirection = 7
Case 157.5 To 180
hdirection = 8
Case 180 To 202.5
hdirection = 9
Case 202.5 To 225
hdirection = 10
Case 225 To 247.5
hdirection = 11
Case 247.5 To 270
hdirection = 12
Case 270 To 292.5
hdirection = 13
Case 292.5 To 315
hdirection = 14
Case 315 To 337.5
hdirection = 15
Case 337.5 To 360
hdirection = 16
End Select
Select Case thiswindspeed
Case 0 To 0.15 ' 0 to 0.6 meters / second
hwindspeed = 0
Case 0.15 To 2.7
hwindspeed = 1
Case 2.7 To 3.6
hwindspeed = 2
Case 3.6 To 7.2
hwindspeed = 3
Case 7.2 To 8.9
hwindspeed = 4
Case 8.9 To 12.5
hwindspeed = 5
Case 12.5 To 14.5
hwindspeed = 6
Case 14.5 To 20
hwindspeed = 7
Case 20 To 22
hwindspeed = 8
Case 22 To 28
hwindspeed = 9
Case 28 To 31
hwindspeed = 10
Case 31 To 37
hwindspeed = 11
Case Is >= 37
hwindspeed = 9
End Select
If hwindspeed = 0 Then
calm = calm + 1
End If
WR(hdirection, hwindspeed) = WR(hdirection, hwindspeed) + 1
summmm = summmm + 1
End If
End If
row = row + 1
Loop
For i = 1 To 16
For j = 1 To 11
Worksheets(1).Cells(5 + i, outcol + j).Value = WR(i, j) / summmm * 100
Next
Next
Worksheets(1).Cells(22, outcol).Value = calm / summmm * 100
End Sub