工况统计程序1.0

工况统计

sub ts()

a = Time


n = Cells(Rows.Count, 2).End(xlUp).Row

Call ts1(n): dq (n):

Call qd


b = Time - a

MsgBox b, n

End Sub

Sub ts1(n)

For i = 2 To n
If Range("L" & i) <> "" Then

j = Range("M" & i - 1).End(xlDown).Row

If j - i < 3 Then

Range("M" & j).Resize(1, 3).Cut Range("M" & i).Resize(1, 3)
End If: End If:  Debug.Print "1---" & i
 
Next i

End Sub


Sub dq(n)


j = 2

For i = 2 To n
If Cells(i, 2) <> "" Then

Cells(i, 1).Resize(1, 5).Copy Cells(j, 17).Resize(1, 5)

j = j + 1
End If
Next

j = 2
For i = 2 To n
If Cells(i, 6) <> "" Then

Cells(i, 6).Resize(1, 3).Copy Cells(j, 22).Resize(1, 3)

j = j + 1
End If
Next

j = 2
For i = 2 To n
If Cells(i, 9) <> "" Then

Cells(i, 9).Resize(1, 3).Copy Cells(j, 25).Resize(1, 3)

j = j + 1
End If
Next

j = 2
For i = 2 To n
If Cells(i, 12) <> "" Then

Cells(i, 12).Resize(1, 4).Copy Cells(j, 28).Resize(1, 4)

j = j + 1
End If
Next

End Sub

Sub qd()

''去除o，非打泵

n = Cells(Rows.Count, 30).End(xlUp).Row
j = 0

For i = n To 2 Step -1
If Cells(i, 30) = 0 Then
       Cells(i, 17).Resize(1, 15).Delete Shift:=xlUp
         j = j + 1
     
    End If
Next

Debug.Print "去除o值个数：" & j
    
End Sub

Sub jd()

n = Cells(Rows.Count, 17).End(xlUp).Row

For i = 2 To n

gk1 = 1: gk2 = 1: gk3 = 1: gk4 = 1

If Cells(i, 20) < -30 And Cells(i, 21) > 30 Then

gk1 = gk1 + 1
Cells(i, 18).Resize(1, 6).Copy Cells(gk1, 33).Resize(1, 6)

ElseIf Cells(i, 18) < 30 And Cells(i, 19) < 30 Then
gk2 = gk2 + 1
Cells(i, 18).Resize(1, 6).Copy Cells(gk2, 39).Resize(1, 6)

ElseIf Cells(i, 18) > 30 Then
gk3 = gk3 + 1
Cells(i, 18).Resize(1, 6).Copy Cells(gk3, 45).Resize(1, 6)

Else
gk4 = gk4 + 1
Cells(i, 18).Resize(1, 6).Copy Cells(gk4, 51).Resize(1, 6)

End If

Debug.Print "n=" & n & "/i=" & i

Next

Cells(1, 33) = "M工况": Cells(1, 39) = "水平工况":
Cells(1, 45) = "拱型工况": Cells(1, 51) = "其他工况"

Debug.Print "M型：" & gk1 - 1: Debug.Print "水平：" & gk2 - 1
Debug.Print "拱型：" & gk3 - 1: Debug.Print "其他：" & gk4 - 1
 



End Sub