用EXCEL的VBA归类风向风速

答案:2 悬赏:50 手机版

解决时间 2021-11-21 11:43

提问者网友：雪舞兮
2021-11-20 19:27

用EXCEL的VBA归类风向风速

最佳答案

五星知识达人网友：長槍戰八方
2021-11-20 20:23

1、截图没有把行号和列标截下来，所以编写VBA输出的结果可能输出位置不满足楼主的需求。
2、重复的数据如何处理，楼主没有明示。如ENE，有17、19、20、28、30等，这样的数据放到右表中，要放哪一个？最大？最小？平均？
3、右表的标题10、16、32的含义？10表示0～9？16表示10～15？32表示16～31？是否可以如此理解。追问1.行数的话就是第一行开始就是一，列的话从第一列开始是C，然后D,E,F,.......
3. 右边的标题表示范围，表示[0~10),[10~16),[16,32),然后大于等于32
2. 要统计数据，比如ENE有17,19,20,28,30，那就要在右边的ENE这一行对应的0~10统计为0,
10-16为0.
16-32为5，大于32为0

C列和D列的原始数据有可能会很长追答Sub 风向风速()
Dim A(16, 4) As Integer
Dim I, J, X As Integer
X = Range("C1").End(xlDown).Row
For I = 2 To 17
For J = 2 To X
If Cells(I, 6) = Cells(J, 4) Then
If Cells(J, 3) < 10 Then
A(I - 2, 0) = A(I - 2, 0) + 1
ElseIf Cells(J, 3) < 16 Then
A(I - 2, 1) = A(I - 2, 1) + 1
ElseIf Cells(J, 3) < 32 Then
A(I - 2, 2) = A(I - 2, 2) + 1
ElseIf Cells(J, 3) >= 32 Then
A(I - 2, 3) = A(I - 2, 3) + 1
End If
End If
Next J
Next I
For I = 2 To 17
Cells(I, 7) = A(I - 2, 0)
Cells(I, 8) = A(I - 2, 1)
Cells(I, 9) = A(I - 2, 2)
Cells(I, 10) = A(I - 2, 3)
Next I
End Sub

全部回答

1楼网友：拾荒鲤
2021-11-20 20:28

             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

我要举报

如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！