Excel VBA自动对故障数据统计分析

Option Explicit
Private Sub MyFirstSubRoutine()
Dim bOpen As Boolean
bOpen = MsgBox("Hello World!")
End Sub

'Set rg = ws.Cells(nRow, nColumn)
'Set rg = ws.Range(ws.Cells(2, 2), ws.Cells(8, 8))
'Set rg = ws.Range("D4", "E5")
'rg.Font.Bold = True
'ws.Range("c1:d2").HorizontalAlignment = xlLeft
Public Sub Manegement()
Dim sName(10) As String
Dim nLenName As Integer
Dim nNumber(10) As Integer
Dim i As Integer
Dim rg As Range
Dim nRow As Integer
Dim nLenRow As Integer
Dim nColumn As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False '程序运行时不刷屏，省时且专业
Set ws = ThisWorkbook.Worksheets(1)
nLenRow = 3500   '总数据列数
nLenName = 0
nColumn = 18    '统计第18列的数据，名称放到sName()中，数量放到nNumber()中，个数为nLenName
For i = 0 To 10
    nNumber(i) = 0
Next
For nRow = 2 To nLenRow       '从第二行开始扫描数据，第一行为标题名称
    Set rg = ws.Cells(nRow, nColumn)
    If Not IsEmpty(rg) Then
        For i = 0 To nLenName - 1
            If StrComp(sName(i), rg.Value) = 0 Then
                nNumber(i) = nNumber(i) + 1
                Exit For
            End If
        Next
        If i = nLenName Then
            sName(nLenName) = rg.Value
            nNumber(nLenName) = 1
            nLenName = nLenName + 1
        End If
    End If
Next
Sort sName, nNumber, nLenName  '按数量从大到小排序
Set ws = ThisWorkbook.Worksheets(2)
ws.Range(ws.Cells(1, 2), ws.Cells(2, 12)).Value = Null   '清空原数据
For i = 0 To nLenName - 1
    Set rg = ws.Cells(1, i + 2)
    rg.Value = sName(i)
    rg.Offset(1, 0) = nNumber(i)
Next
For i = 0 To nLenName - 1
    SubManegement nLenRow, sName(i), 3 + i
Next
Set rg = Nothing
Set ws = Nothing
Application.ScreenUpdating = True  '程序运行完刷屏
End Sub
Private Sub Sort(ByRef sName() As String, ByRef nNumber() As Integer, ByRef nLenName As Integer)
Dim i As Integer
Dim bFinished As Boolean
Dim sNameTemp As String
Dim nNumberTemp As Integer
bFinished = False
Do While Not bFinished
    bFinished = True
    For i = 0 To nLenName
        If nNumber(i) < nNumber(i + 1) Then
            sNameTemp = sName(i)
            nNumberTemp = nNumber(i)
            nNumber(i) = nNumber(i + 1)
            sName(i) = sName(i + 1)
            sName(i + 1) = sNameTemp
            nNumber(i + 1) = nNumberTemp
            bFinished = False
        End If
    Next
Loop
End Sub
'nLenRow --总数据列数；sNameSelected--条件系统名称；nNofpage--写入数据的页序号
Private Sub SubManegement(nLenRow As Integer, sNameSelected As String, nNofPage As Integer)
Dim sName(10) As String
Dim nLenName As Integer
Dim nNumber(10) As Integer
Dim i As Integer
Dim rg As Range
Dim nRow As Integer
Dim nColumn As Integer
Dim ws As Worksheet
Dim sLC
Dim j As Integer
Set ws = ThisWorkbook.Worksheets(1)
'nLenRow = 100   '总数据列数-------------------------------------
nLenName = 0
nColumn = 19    '统计第19列的数据，名称放到sName()中，数量放到nNumber()中，个数为nLenName
For i = 0 To 10
    nNumber(i) = 0
Next
For nRow = 2 To nLenRow       '从第二行开始扫描数据，第一行为标题名称
    Set rg = ws.Cells(nRow, nColumn)
    If Not IsEmpty(rg) And rg.Offset(0, -1).Value = sNameSelected Then
        For i = 0 To nLenName - 1
            If StrComp(sName(i), rg.Value) = 0 Then
                nNumber(i) = nNumber(i) + 1
                Exit For
            End If
        Next
        If i = nLenName Then
            sName(nLenName) = rg.Value
            nNumber(nLenName) = 1
            nLenName = nLenName + 1
        End If
    End If
Next
Sort sName, nNumber, nLenName  '按数量从大到小排序
Set ws = ThisWorkbook.Worksheets(nNofPage)
ws.Range(ws.Cells(1, 2), ws.Cells(2, 12)).Value = Null   '清空原数据
ws.Range(ws.Cells(6, 2), ws.Cells(10, 12)).Value = Null   '清空原数据
ws.Range("a1").Value = sNameSelected & ":"
For i = 0 To nLenName - 1
    Set rg = ws.Cells(1, i + 2)
    rg.Value = sName(i)
    rg.Offset(1, 0) = nNumber(i)
Next
sLC = Array(">5万km", ">2～5万km", ">1～2万km", ">5千～1万km", "<=5千km")
'nLenRow = 100   '总数据列数--------------------------------------------
For j = 0 To UBound(sLC) - LBound(sLC)
    Set ws = ThisWorkbook.Worksheets(1)   '注意每次统计数据都在数据表1中！！！
    nLenName = 0
    nColumn = 19    '统计第19列的数据，名称放到sName()中，数量放到nNumber()中，个数为nLenName
    For i = 0 To 10
        nNumber(i) = 0
    Next
    For nRow = 2 To nLenRow       '从第二行开始扫描数据，第一行为标题名称
        Set rg = ws.Cells(nRow, nColumn)
        If Not IsEmpty(rg) And rg.Offset(0, -1).Value = sNameSelected And rg.Offset(0, 2).Value = sLC(j) Then
            For i = 0 To nLenName - 1
                If StrComp(sName(i), rg.Value) = 0 Then
                    nNumber(i) = nNumber(i) + 1
                    Exit For
                End If
            Next
            If i = nLenName Then
                sName(nLenName) = rg.Value
                nNumber(nLenName) = 1
                nLenName = nLenName + 1
            End If
        End If
    Next
    '将里程故障数添加到下5行中
    Set ws = ThisWorkbook.Worksheets(nNofPage)
    For i = 0 To nLenName - 1
        Set rg = ws.Cells(1, 2)  '对比故障名称
        Do Until IsEmpty(rg)
            If rg.Value = sName(i) Then
                rg.Offset(5 + j, 0) = nNumber(i)
            End If
            Set rg = rg.Offset(0, 1)
        Loop
    Next
Next
Set rg = Nothing
Set ws = Nothing
End Sub
Public Sub AddLC()
Dim rg As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
Application.ScreenUpdating = False '程序运行时不刷屏，省时且专业
Set rg = ws.Cells(2, 1)
Do Until IsEmpty(rg)
    Select Case rg.Offset(0, 6)
        Case Is <= 5000
            rg.Offset(0, 20).Value = "<=5千km"
        Case 5000 To 10000
            rg.Offset(0, 20).Value = ">5千～1万km"
        Case 10000 To 20000
            rg.Offset(0, 20).Value = ">1～2万km"
        Case 20000 To 50000
            rg.Offset(0, 20).Value = ">2～5万km"
        Case Else
            rg.Offset(0, 20).Value = ">5万km"
    End Select
    Set rg = rg.Offset(1, 0)
Loop
Application.ScreenUpdating = True  '程序运行完刷屏
End Sub