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-12
Dim i As Integer   '6-66
Dim j As Integer   '3-26
Dim 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