excel vba 玫瑰圖 風速 風向

             
Sub cal()Dim wN As Double       '北Dim wNNE As Double     '北東北Dim wNE As Double      '東北Dim wENE As Double     '東東北Dim wE As Double       '東Dim wESE As Double     '東東南Dim wSE As Double      '東南Dim wSSE As Double     '南東南Dim wS As Double       '南Dim wSSW As Double     '南西南Dim wSW As Double      '西南Dim wWSW As Double     '西西南Dim wW As Double       '西Dim wWNW As Double     '西西北Dim wNW As Double      '西北Dim wNNW As Double     '北西北  Dim vN As Double       '北Dim vNNE As Double     '北東北Dim vNE As Double      '東北Dim vENE As Double     '東東北Dim vE As Double       '東Dim vESE As Double     '東東南Dim vSE As Double      '東南Dim vSSE As Double     '南東南Dim vS As Double       '南Dim vSSW As Double     '南西南Dim vSW As Double      '西南Dim vWSW As Double     '西西南Dim vW As Double       '西Dim vWNW As Double     '西西北Dim vNW As Double      '西北Dim vNNW As Double     '北西北 Dim num As Integer '1-12Dim i As Integer   '6-66Dim j As Integer   '3-26Dim nameid As Integer '1-15   For num = 1 To Sheets.Count    For i = 6 To 66 Step 2     For j = 3 To 26               If Sheets(num).Cells(i, j) <> "" Then             If Sheets(num).Cells(i, j) > 348.76 Or Sheets(num).Cells(i, j) < 11.25 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wN = wN + 1                vN = vN + Sheets(num).Cells(i + 1, j)               End If                                             ElseIf Sheets(num).Cells(i, j) > 11.26 And Sheets(num).Cells(i, j) < 33.75 Then              If Sheets(num).Cells(i + 1, j) > 5# Then                wNNE = wNNE + 1                vNNE = vNNE + Sheets(num).Cells(i + 1, j)               End If                                             ElseIf Sheets(num).Cells(i, j) > 33.76 And Sheets(num).Cells(i, j) < 56.25 Then              If Sheets(num).Cells(i + 1, j) > 5# Then               wNE = wNE + 1               vNE = vNE + Sheets(num).Cells(i + 1, j)              End If                                           ElseIf Sheets(num).Cells(i, j) > 56.26 And Sheets(num).Cells(i, j) < 78.75 Then              If Sheets(num).Cells(i + 1, j) > 5# Then               wENE = wENE + 1               vENE = vENE + Sheets(num).Cells(i + 1, j)             End If                                        ElseIf Sheets(num).Cells(i, j) > 78.76 And Sheets(num).Cells(i, j) < 101.25 Then             If Sheets(num).Cells(i + 1, j) > 5# Then              wE = wE + 1              vE = vE + Sheets(num).Cells(i + 1, j)             End If                                         ElseIf Sheets(num).Cells(i, j) > 101.26 And Sheets(num).Cells(i, j) < 123.75 Then              If Sheets(num).Cells(i + 1, j) > 5# Then               wESE = wESE + 1               vESE = vESE + Sheets(num).Cells(i + 1, j)             End If                                          ElseIf Sheets(num).Cells(i, j) > 123.76 And Sheets(num).Cells(i, j) < 146.25 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wSE = wSE + 1                vSE = vSE + Sheets(num).Cells(i + 1, j)               End If                                              ElseIf Sheets(num).Cells(i, j) > 146.26 And Sheets(num).Cells(i, j) < 168.75 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wSSE = wSSE + 1                vSSE = vSSE + Sheets(num).Cells(i + 1, j)               End If                                              ElseIf Sheets(num).Cells(i, j) > 168.76 And Sheets(num).Cells(i, j) < 191.25 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wS = wS + 1                vS = vS + Sheets(num).Cells(i + 1, j)               End If                       ElseIf Sheets(num).Cells(i, j) > 191.26 And Sheets(num).Cells(i, j) < 213.75 Then                If Sheets(num).Cells(i + 1, j) > 5# Then                wSSW = wSSW + 1                vSSW = vSSW + Sheets(num).Cells(i + 1, j)               End If                                                   ElseIf Sheets(num).Cells(i, j) > 213.76 And Sheets(num).Cells(i, j) < 236.25 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wSW = wSW + 1                vSW = vSW + Sheets(num).Cells(i + 1, j)               End If                                                                            ElseIf Sheets(num).Cells(i, j) > 236.26 And Sheets(num).Cells(i, j) < 258.75 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wWSW = wWSW + 1                vWSW = vWSW + Sheets(num).Cells(i + 1, j)               End If                                                                                    ElseIf Sheets(num).Cells(i, j) > 258.76 And Sheets(num).Cells(i, j) < 281.25 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wW = wW + 1                vW = vW + Sheets(num).Cells(i + 1, j)               End If                                                                                        ElseIf Sheets(num).Cells(i, j) > 281.26 And Sheets(num).Cells(i, j) < 303.75 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                 wWNW = wWNW + 1                 vWNW = vWNW + Sheets(num).Cells(i + 1, j)               End If                                                                                             ElseIf Sheets(num).Cells(i, j) > 303.76 And Sheets(num).Cells(i, j) < 326.25 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wNW = wNW + 1                vNW = vNW + Sheets(num).Cells(i + 1, j)               End If                                                                                                ElseIf Sheets(num).Cells(i, j) > 326.26 And Sheets(num).Cells(i, j) < 348.75 Then               If Sheets(num).Cells(i + 1, j) > 5# Then                wNNW = wNNW + 1                vNNW = vNNW + Sheets(num).Cells(i + 1, j)               End If                                End If        End If                   Next j    Next i        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''    Dim filename As String    filename = ""    For nameid = 1 To 15      filename = filename & Sheets(num).Cells(4, nameid)    Next nameid        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''        Dim sFile As Object, FSO As Object    Set FSO = CreateObject("Scripting.FileSystemObject")    Set sFile = FSO.CreateTextFile("C:\" & filename & ".txt", True)         sFile.WriteLine ("wN" & vbTab & wN)    sFile.WriteLine ("wNNE" & vbTab & wNNE)    sFile.WriteLine ("wNE" & vbTab & wNE)    sFile.WriteLine ("wENE" & vbTab & wENE)         sFile.WriteLine ("wE" & vbTab & wE)    sFile.WriteLine ("wESE" & vbTab & wESE)    sFile.WriteLine ("wSE" & vbTab & wSE)    sFile.WriteLine ("wSSE" & vbTab & wSSE)         sFile.WriteLine ("wS" & vbTab & wS)    sFile.WriteLine ("wSSW" & vbTab & wSSW)    sFile.WriteLine ("wSW" & vbTab & wSW)    sFile.WriteLine ("wWSW" & vbTab & wWSW)         sFile.WriteLine ("wW" & vbTab & wW)    sFile.WriteLine ("wWNW" & vbTab & wWNW)    sFile.WriteLine ("wNW" & vbTab & wNW)    sFile.WriteLine ("wNNW" & vbTab & wNNW)         ''''''''''''''''''''''''''''''''''    sFile.WriteLine ("vN" & vbTab & vN)    sFile.WriteLine ("vNNE" & vbTab & vNNE)    sFile.WriteLine ("wNE" & vbTab & wNE)    sFile.WriteLine ("vENE" & vbTab & vENE)         sFile.WriteLine ("vE" & vbTab & vE)    sFile.WriteLine ("vESE" & vbTab & vESE)    sFile.WriteLine ("vSE" & vbTab & vSE)    sFile.WriteLine ("vSSE" & vbTab & vSSE)         sFile.WriteLine ("vS" & vbTab & vS)    sFile.WriteLine ("vSSW" & vbTab & vSSW)    sFile.WriteLine ("vSW" & vbTab & vSW)    sFile.WriteLine ("vWSW" & vbTab & vWSW)         sFile.WriteLine ("vW" & vbTab & vW)    sFile.WriteLine ("vWNW" & vbTab & vWNW)    sFile.WriteLine ("vNW" & vbTab & vNW)    sFile.WriteLine ("vNNW" & vbTab & vNNW)         sFile.Close    Set sFile = Nothing    Set FSO = Nothing    Next num MsgBox "計算完成"End Sub