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