Excel Macro Cheap Windrose

From IARC 207 Wiki
Jump to navigation Jump to search
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