vba2010 处理土壤分析单因子，内梅罗，地质累积方法自动计算程序

Sub 潜在生态计算RI()
Dim i%, s!, row%
i = 4
Do While Cells(i, 25) <> ""                                       '以铜列为控制循环计算列
Sheet2.Cells(i, 11) = Cells(i, 2)
Sheet2.Cells(i, 1) = Cells(i, 24) / Cells(2, 43) * Cells(3, 43)   '计算镉Cd
Sheet2.Cells(i, 2) = Cells(i, 25) / Cells(2, 44) * Cells(3, 44)   '计算铜
Sheet2.Cells(i, 3) = Cells(i, 26) / Cells(2, 45) * Cells(3, 45)   '计算铅
Sheet2.Cells(i, 4) = Cells(i, 27) / Cells(2, 46) * Cells(3, 46)   '计算Cr铬
Sheet2.Cells(i, 5) = Cells(i, 28) / Cells(2, 47) * Cells(3, 47)   '计算锌
'Sheet2.Cells(i, 6) = Cells(i, 29) / Cells(2, 48) * Cells(3, 48)   '计算锰
Sheet2.Cells(i, 7) = Cells(i, 30) / Cells(2, 49) * Cells(3, 49)   '计算汞
Sheet2.Cells(i, 8) = Cells(i, 31) / Cells(2, 50) * Cells(3, 50)   '计算砷
Sheet2.Cells(i, 9) = Cells(i, 32) / Cells(2, 51) * Cells(3, 51)   '计算镍
Sheet2.Cells(i, 10) = Sheet2.Cells(i, 1) + Sheet2.Cells(i, 2) + Sheet2.Cells(i, 3) + Sheet2.Cells(i, 4) + Sheet2.Cells(i, 5) + Sheet2.Cells(i, 7) + Sheet2.Cells(i, 8) + Sheet2.Cells(i, 9) + Sheet2.Cells(i, 10)   '计算潜在RI值
    For row = 1 To 9
        s = Sheet2.Cells(i, row)
        Select Case s
        Case Is <= 40
        Sheet2.Cells(i, row + 11) = "轻微"
        Case Is <= 80
        Sheet2.Cells(i, row + 11) = "中等"
        Case Is <= 160
        Sheet2.Cells(i, row + 11) = "强"
        Case Is <= 320
        Sheet2.Cells(i, row + 11) = "很强"
        Case Else
        Sheet2.Cells(i, row + 11) = "极强"
        End Select
    Next
If Sheet2.Cells(i, 10) > 600 Then
Cells(i, 35).Interior.ColorIndex = 3
Cells(i, 35) = "极强"
ElseIf Sheet2.Cells(i, 10) > 300 Then
Cells(i, 35).Interior.ColorIndex = 27
Cells(i, 35) = "强"
ElseIf Sheet2.Cells(i, 10) > 150 Then
Cells(i, 35).Interior.ColorIndex = 4
Cells(i, 35) = "中"
Else: Cells(i, 35).Interior.ColorIndex = 8
Cells(i, 35) = "轻微"
End If
  i = i + 1
Loop
End Sub



Sub 清色()
Dim i%
i = 4
Do While Cells(i, 25) <> ""
Cells(i, 35).Interior.ColorIndex = 0
Cells(i, 36).Interior.ColorIndex = 0
Sheet2.Rows(4).Delete
Sheet3.Rows(4).Delete
Sheet4.Rows(4).Delete
Sheet5.Rows(4).Delete
  i = i + 1
Loop
Range("AP4:BA27").ClearContents
Range("AI4", "AL" & i).ClearContents
End Sub



Sub 潜在统计()
Dim a%, b%, c%, d%, e%, f%, g%, h%, i%, j%, k%, l%, qw%, zh%, qq%, jq%
Dim rng%, col%, q1%, q2%, q3%, q4%, q5%
a = 4
Do While Cells(a, 25) <> ""
   If Cells(a, 24) > Cells(2, 43) Then b = b + 1
   If Cells(a, 25) > Cells(2, 44) Then c = c + 1
   If Cells(a, 26) > Cells(2, 45) Then d = d + 1
   If Cells(a, 27) > Cells(2, 46) Then e = e + 1
   If Cells(a, 28) > Cells(2, 47) Then f = f + 1
   If Cells(a, 29) > Cells(2, 48) Then g = g + 1
   If Cells(a, 30) > Cells(2, 49) Then h = h + 1
   If Cells(a, 31) > Cells(2, 50) Then i = i + 1
   If Cells(a, 32) > Cells(2, 51) Then j = j + 1
   If Cells(a, 33) > Cells(2, 52) Then k = k + 1
   If Cells(a, 34) > Cells(2, 53) Then l = l + 1
   If Cells(a, 35) = "轻微" Then qw = qw + 1
   If Cells(a, 35) = "中" Then zh = zh + 1
   If Cells(a, 35) = "强" Then qq = qq + 1
   If Cells(a, 35) = "极强" Then jq = jq + 1
  a = a + 1
Loop
Cells(5, 43) = b / (a - 4)
Cells(5, 44) = c / (a - 4)
Cells(5, 45) = d / (a - 4)
Cells(5, 46) = e / (a - 4)
Cells(5, 47) = f / (a - 4)
Cells(5, 48) = g / (a - 4)
Cells(5, 49) = h / (a - 4)
Cells(5, 50) = i / (a - 4)
Cells(5, 51) = j / (a - 4)
Cells(5, 52) = k / (a - 4)
Cells(5, 53) = l / (a - 4)
Cells(4, 42) = "超标个数"
Cells(5, 42) = "超标率"
Cells(9, 42) = "很强个数"
Cells(6, 42) = "轻微个数"
Cells(7, 42) = "中个数"
Cells(8, 42) = "强个数"
Cells(10, 42) = "极强个数"
Cells(6, 55) = a - 4
Cells(6, 54) = qw
Cells(7, 54) = zh
Cells(8, 54) = qq
Cells(10, 54) = jq
Cells(4, 43) = b
Cells(4, 44) = c
Cells(4, 45) = d
Cells(4, 46) = e
Cells(4, 47) = f
Cells(4, 48) = g
Cells(4, 49) = h
Cells(4, 50) = i
Cells(4, 51) = j
Cells(4, 52) = k
Cells(4, 53) = l
For col = 12 To 20
     row = 4
    Do While Cells(row, 25) <> ""
    If Sheet2.Cells(row, col) = "轻微" Then q1 = q1 + 1
    If Sheet2.Cells(row, col) = "中等" Then q2 = q2 + 1
    If Sheet2.Cells(row, col) = "强" Then q3 = q3 + 1
    If Sheet2.Cells(row, col) = "很强" Then q4 = q4 + 1
    If Sheet2.Cells(row, col) = "极强" Then q5 = q5 + 1
        row = row + 1
    Loop
  Cells(6, col + 31) = q1
  Cells(7, col + 31) = q2
  Cells(8, col + 31) = q3
  Cells(9, col + 31) = q4
  Cells(10, col + 31) = q5
  q1 = 0
  q2 = 0
  q3 = 0
  q4 = 0
  q5 = 0
  
Next
Range("AV6:AV10").ClearContents
End Sub


Sub 内梅罗计算()
Dim a!, b!, c!, d!, e!, f!, g!, h!, rng%, s!, m!, n!
rng = 4
Do While Cells(rng, 25) <> ""
   Select Case Cells(rng, 23)
     Case Is <= 5.5
          a = 0.3
          b = 50
          c = 70
          d = 150
          e = 200
          f = 1.3
          g = 40
          h = 60
     Case Is <= 6.5
          a = 0.3
          b = 50
          c = 90
          d = 150
          e = 200
          f = 1.8
          g = 40
          h = 70
     Case Is <= 7.5
          a = 0.3
          b = 100
          c = 120
          d = 200
          e = 250
          f = 2.4
          g = 30
          h = 100
   Case Else
          a = 0.6
          b = 100
          c = 170
          d = 250
          e = 300
          f = 3.4
          g = 25
          h = 190
    End Select              'Ph判别筛选值完成
Sheet3.Cells(rng, 1) = Cells(rng, 24) / a   '计算镉Cd
Sheet3.Cells(rng, 2) = Cells(rng, 25) / b   '计算铜
Sheet3.Cells(rng, 3) = Cells(rng, 26) / c   '计算铅
Sheet3.Cells(rng, 4) = Cells(rng, 27) / d   '计算Cr铬
Sheet3.Cells(rng, 5) = Cells(rng, 28) / e  '计算锌
Sheet3.Cells(rng, 7) = Cells(rng, 30) / f   '计算汞
Sheet3.Cells(rng, 8) = Cells(rng, 31) / g   '计算砷
Sheet3.Cells(rng, 9) = Cells(rng, 32) / h  '计算镍    Pi计算完成
m = (Sheet3.Cells(rng, 1) * 3 + Sheet3.Cells(rng, 2) * 2 + Sheet3.Cells(rng, 3) * 3 + Sheet3.Cells(rng, 4) * 2 + Sheet3.Cells(rng, 5) * 2 + Sheet3.Cells(rng, 7) * 3 + Sheet3.Cells(rng, 8) * 3 + Sheet3.Cells(rng, 9) * 2) / (3 * 2 * 3 * 2 * 2 * 3 * 3 * 2)  '计算潜在RI值
n = Application.WorksheetFunction.Max(Sheet3.Range("a" & rng, "i" & rng))
Sheet3.Cells(rng, 10) = ((m ^ 2 + n ^ 2) / 2) ^ (1 / 2)
s = Sheet3.Cells(rng, 10)
  If s > 3 Then
Cells(rng, 36).Interior.ColorIndex = 3
Cells(rng, 36) = "重污染"
ElseIf s > 2 Then
Cells(rng, 36).Interior.ColorIndex = 27
Cells(rng, 36) = "中污染"
ElseIf s > 1 Then
Cells(rng, 36).Interior.ColorIndex = 4
Cells(rng, 36) = "轻污染"
ElseIf s > 0.7 Then
Cells(rng, 36).Interior.ColorIndex = 8
Cells(rng, 36) = "警戒线"
Else: Cells(rng, 36).Interior.ColorIndex = 17
Cells(rng, 36) = "安全"
End If
   rng = rng + 1
Loop
End Sub




Sub 内梅罗统计()
Dim aq%, jj%, qw%, zw%, zz%, a%
a = 4
Do While Cells(a, 25) <> ""
   If Cells(a, 36) = "安全" Then aq = aq + 1
   If Cells(a, 36) = "警戒线" Then jj = jj + 1
   If Cells(a, 36) = "轻污染" Then qw = qw + 1
   If Cells(a, 36) = "中污染" Then zw = zw + 1
   If Cells(a, 36) = "重污染" Then zz = zz + 1
  a = a + 1
Loop
Cells(11, 42) = "分析个数"
Cells(12, 42) = "安全个数"
Cells(13, 42) = "警戒线个数"
Cells(14, 42) = "轻污染个数"
Cells(15, 42) = "中污染个数"
Cells(16, 42) = "重污染个数"
Cells(11, 43) = a - 4
Cells(12, 43) = aq
Cells(13, 43) = jj
Cells(14, 43) = qw
Cells(15, 43) = zw
Cells(16, 43) = zz
End Sub



Sub 地质累积计算()
Dim rng%
rng = 4
Do While Cells(rng, 25) <> ""
    Sheet4.Cells(rng, 1) = Cells(rng, 2)
    Sheet4.Cells(rng, 2) = Log(Cells(rng, 24) / (1.5 * Cells(2, 43))) / Log(2) '计算镉Cd
    Sheet4.Cells(rng, 3) = Log(Cells(rng, 25) / (1.5 * Cells(2, 44))) / Log(2)   '计算铜
    Sheet4.Cells(rng, 4) = Log(Cells(rng, 26) / (1.5 * Cells(2, 45))) / Log(2)   '计算铅
    Sheet4.Cells(rng, 5) = Log(Cells(rng, 27) / (1.5 * Cells(2, 46))) / Log(2)    '计算Cr铬
    Sheet4.Cells(rng, 6) = Log(Cells(rng, 28) / (1.5 * Cells(2, 47))) / Log(2) '计算锌
    Sheet4.Cells(rng, 8) = Log(Cells(rng, 30) / (1.5 * Cells(2, 49))) / Log(2)   '计算汞
    Sheet4.Cells(rng, 9) = Log(Cells(rng, 31) / (1.5 * Cells(2, 50))) / Log(2)   '计算砷
    Sheet4.Cells(rng, 10) = Log(Cells(rng, 32) / (1.5 * Cells(2, 51))) / Log(2) '计算镍    地累积计算完成
    Sheet4.Cells(rng, 11) = (Sheet4.Cells(rng, 2) + Sheet4.Cells(rng, 3) + Sheet4.Cells(rng, 4) + Sheet4.Cells(rng, 5) + Sheet4.Cells(rng, 6) + Sheet4.Cells(rng, 8) + Sheet4.Cells(rng, 9) + Sheet4.Cells(rng, 10)) / 8
    For i = 2 To 11
    s = Sheet4.Cells(rng, i)
       If s < 0 Then
            Sheet4.Cells(rng, i + 11) = "I级"
        ElseIf s < 1 Then
            Sheet4.Cells(rng, i + 11) = "II级"
        ElseIf s < 2 Then
            Sheet4.Cells(rng, i + 11) = "III级"
        ElseIf s < 3 Then
            Sheet4.Cells(rng, i + 11) = "IV级"
        ElseIf s < 4 Then
            Sheet4.Cells(rng, i + 11) = "V级"
        ElseIf s < 5 Then
            Sheet4.Cells(rng, i + 11) = "VI级"
        Else
            Sheet4.Cells(rng, i + 11) = "VII级"
        End If
    Next
    Cells(rng, 37) = Sheet4.Cells(rng, 22)
 rng = rng + 1
Loop
End Sub


Sub 地质累积统计()
Dim q1%, q2%, q3%, q4%, q5%, q6%, q7%, a%, i%
For i = 13 To 22
a = 4
 Do While Cells(a, 25) <> ""
   If Sheet4.Cells(a, i) = "I级" Then q1 = q1 + 1
   If Sheet4.Cells(a, i) = "II级" Then q2 = q2 + 1
   If Sheet4.Cells(a, i) = "III级" Then q3 = q3 + 1
   If Sheet4.Cells(a, i) = "IV级" Then q4 = q4 + 1
   If Sheet4.Cells(a, i) = "V级" Then q5 = q5 + 1
   If Sheet4.Cells(a, i) = "VI级" Then q6 = q6 + 1
   If Sheet4.Cells(a, i) = "VII级" Then q7 = q7 + 1
  a = a + 1
 Loop
Cells(17, 30 + i) = q1
Cells(18, 30 + i) = q2
Cells(19, 30 + i) = q3
Cells(20, 30 + i) = q4
Cells(21, 30 + i) = q5
Cells(22, 30 + i) = q6
Cells(23, 30 + i) = q7
q1 = 0
q2 = 0
q3 = 0
q4 = 0
q5 = 0
q6 = 0
q7 = 0
Next
Cells(17, 42) = "I级个数"
Cells(18, 42) = "II级个数"
Cells(19, 42) = "III级个数"
Cells(20, 42) = "IV级个数"
Cells(21, 42) = "V级个数"
Cells(22, 42) = "VI个数"
Cells(23, 42) = "VII个数"
End Sub



Sub 单因子计算()
Dim a!, b!, c!, d!, e!, f!, g!, h!, rng%, s!, m!, n!, aa!, cc!, dd!, ff!
rng = 4
Do While Cells(rng, 25) <> ""
    Sheet5.Cells(rng, 1) = Cells(rng, 2)
   Select Case Cells(rng, 23)
     Case Is <= 5.5
          a = 0.3
          b = 50
          c = 70
          d = 150
          e = 200
          f = 1.3
          g = 40
          h = 60
          aa = 1.5
          cc = 400
          dd = 800
          ff = 2
          gg = 200
     Case Is <= 6.5
          a = 0.3
          b = 50
          c = 90
          d = 150
          e = 200
          f = 1.8
          g = 40
          h = 70
          aa = 2
          cc = 500
          dd = 850
          ff = 2.5
          gg = 150
     Case Is <= 7.5
          a = 0.3
          b = 100
          c = 120
          d = 200
          e = 250
          f = 2.4
          g = 30
          h = 100
          aa = 3
          cc = 700
          dd = 1000
          ff = 4
          gg = 120
     Case Else
          a = 0.6
          b = 100
          c = 170
          d = 250
          e = 300
          f = 3.4
          g = 25
          h = 190
          aa = 4
          cc = 1000
          dd = 1200
          ff = 6
          gg = 100
      End Select              'Ph判别筛选值完成
Sheet5.Cells(rng, 2) = Cells(rng, 24) / a   '计算镉Cd a aa
Sheet5.Cells(rng, 3) = Cells(rng, 25) / b   '计算铜
Sheet5.Cells(rng, 4) = Cells(rng, 26) / c   '计算铅  c cc
Sheet5.Cells(rng, 5) = Cells(rng, 27) / d   '计算Cr铬 d dd
Sheet5.Cells(rng, 6) = Cells(rng, 28) / e  '计算锌
Sheet5.Cells(rng, 8) = Cells(rng, 30) / f   '计算汞 f ff
Sheet5.Cells(rng, 9) = Cells(rng, 31) / g   '计算砷 g gg
Sheet5.Cells(rng, 10) = Cells(rng, 32) / h  '计算镍    计算完成

Sheet5.Cells(rng, 12) = Cells(rng, 24) / aa   '计算镉Cd a aa
Sheet5.Cells(rng, 13) = Cells(rng, 26) / cc   '计算铅  c cc
Sheet5.Cells(rng, 14) = Cells(rng, 27) / dd   '计算Cr铬 d dd
Sheet5.Cells(rng, 15) = Cells(rng, 30) / ff   '计算汞 f ff
Sheet5.Cells(rng, 16) = Cells(rng, 31) / gg   '计算砷 g gg    计算完成


 Select Case Sheet5.Cells(rng, 2)
    Case Is <= 1
        Sheet5.Cells(rng, 18) = "风险低"
    Case Else
        If Sheet5.Cells(rng, 12) <= 1 Then
        Sheet5.Cells(rng, 18) = "存在风险"
        ElseIf Sheet5.Cells(rng, 12) > 1 Then
        Sheet5.Cells(rng, 18) = "风险高"
        End If
    End Select                                   '判定镉Cd
    
  Select Case Sheet5.Cells(rng, 3)
    Case Is <= 1
        Sheet5.Cells(rng, 19) = "风险低"
    Case Else
        Sheet5.Cells(rng, 19) = "存在风险"
    End Select                                '判定Cu
  
 Select Case Sheet5.Cells(rng, 4)
    Case Is <= 1
        Sheet5.Cells(rng, 20) = "风险低"
    Case Else
        If Sheet5.Cells(rng, 13) <= 1 Then
        Sheet5.Cells(rng, 20) = "存在风险"
        ElseIf Sheet5.Cells(rng, 13) > 1 Then
        Sheet5.Cells(rng, 20) = "风险高"
        End If
    End Select                                   '判定Pb
 
 Select Case Sheet5.Cells(rng, 5)
    Case Is <= 1
        Sheet5.Cells(rng, 21) = "风险低"
    Case Else
        If Sheet5.Cells(rng, 14) <= 1 Then
        Sheet5.Cells(rng, 21) = "存在风险"
        ElseIf Sheet5.Cells(rng, 14) > 1 Then
        Sheet5.Cells(rng, 21) = "风险高"
        End If
    End Select                                   '判定Cr
 
 Select Case Sheet5.Cells(rng, 6)
    Case Is <= 1
        Sheet5.Cells(rng, 22) = "风险低"
    Case Else
        Sheet5.Cells(rng, 22) = "存在风险"
    End Select                                '判定Zn
  
  Select Case Sheet5.Cells(rng, 8)
    Case Is <= 1
        Sheet5.Cells(rng, 24) = "风险低"
    Case Else
        If Sheet5.Cells(rng, 15) <= 1 Then
        Sheet5.Cells(rng, 24) = "存在风险"
        ElseIf Sheet5.Cells(rng, 15) > 1 Then
        Sheet5.Cells(rng, 24) = "风险高"
        End If
    End Select                                   '判定Hg
 
  Select Case Sheet5.Cells(rng, 9)
    Case Is <= 1
        Sheet5.Cells(rng, 25) = "风险低"
    Case Else
        If Sheet5.Cells(rng, 16) <= 1 Then
        Sheet5.Cells(rng, 25) = "存在风险"
        ElseIf Sheet5.Cells(rng, 16) > 1 Then
        Sheet5.Cells(rng, 25) = "风险高"
        End If
    End Select                                   '判定As
 
 Select Case Sheet5.Cells(rng, 10)
    Case Is <= 1
        Sheet5.Cells(rng, 26) = "风险低"
    Case Else
        Sheet5.Cells(rng, 26) = "存在风险"
    End Select                                '判定Ni
    
     If Sheet5.Cells(rng, 18) = "风险高" Or Sheet5.Cells(rng, 19) = "风险高" Or Sheet5.Cells(rng, 20) = "风险高" Or Sheet5.Cells(rng, 21) = "风险高" _
    Or Sheet5.Cells(rng, 22) = "风险高" Or Sheet5.Cells(rng, 24) = "风险高" Or Sheet5.Cells(rng, 25) = "风险高" Or Sheet5.Cells(rng, 26) = "风险高" Then
      Sheet5.Cells(rng, 27) = "风险高"
      Cells(rng, 38) = "风险高"
      ElseIf Sheet5.Cells(rng, 18) = "存在风险" Or Sheet5.Cells(rng, 19) = "存在风险" Or Sheet5.Cells(rng, 20) = "存在风险" Or Sheet5.Cells(rng, 21) = "存在风险" _
    Or Sheet5.Cells(rng, 22) = "存在风险" Or Sheet5.Cells(rng, 24) = "存在风险" Or Sheet5.Cells(rng, 25) = "存在风险" Or Sheet5.Cells(rng, 26) = "存在风险" Then
      Sheet5.Cells(rng, 27) = "存在风险"
      Cells(rng, 38) = "存在风险"
      ElseIf Sheet5.Cells(rng, 18) = "风险低" Or Sheet5.Cells(rng, 19) = "风险低" Or Sheet5.Cells(rng, 20) = "风险低" Or Sheet5.Cells(rng, 21) = "风险低" _
    Or Sheet5.Cells(rng, 22) = "风险低" Or Sheet5.Cells(rng, 24) = "风险低" Or Sheet5.Cells(rng, 25) = "风险低" Or Sheet5.Cells(rng, 26) = "风险低" Then
      Sheet5.Cells(rng, 27) = "风险低"
      Cells(rng, 38) = "风险低"
      End If                     '综合风险判定
    

   rng = rng + 1
Loop
End Sub




Sub 单因子统计()
Dim fd%, cf%, fg%, a%, i%
For i = 18 To 26
a = 4
 Do While Cells(a, 25) <> ""
   If Sheet5.Cells(a, i) = "风险低" Then fd = fd + 1
   If Sheet5.Cells(a, i) = "存在风险" Then cf = cf + 1
   If Sheet5.Cells(a, i) = "风险高" Then fg = fg + 1
  a = a + 1
 Loop
Cells(24, 25 + i) = fd
Cells(25, 25 + i) = cf
Cells(26, 25 + i) = fg
fd = 0
cf = 0
fg = 0
Next
Cells(27, 43) = a - 4
Cells(24, 42) = "风险低个数"
Cells(25, 42) = "存在风险个数"
Cells(26, 42) = "风险高个数"
Cells(27, 42) = "样品总个数"
End Sub



Sub 测试()
Dim rng%
rng = 4
Do While Sheet5.Cells(rng, 8) <> ""
 If Sheet5.Cells(rng, 18) = "风险高" Or Sheet5.Cells(rng, 19) = "风险高" Or Sheet5.Cells(rng, 20) = "风险高" Or Sheet5.Cells(rng, 21) = "风险高" _
    Or Sheet5.Cells(rng, 22) = "风险高" Or Sheet5.Cells(rng, 24) = "风险高" Or Sheet5.Cells(rng, 25) = "风险高" Or Sheet5.Cells(rng, 26) = "风险高" Then
      Sheet5.Cells(rng, 27) = "风险高"
      ElseIf Sheet5.Cells(rng, 18) = "存在风险" Or Sheet5.Cells(rng, 19) = "存在风险" Or Sheet5.Cells(rng, 20) = "存在风险" Or Sheet5.Cells(rng, 21) = "存在风险" _
    Or Sheet5.Cells(rng, 22) = "存在风险" Or Sheet5.Cells(rng, 24) = "存在风险" Or Sheet5.Cells(rng, 25) = "存在风险" Or Sheet5.Cells(rng, 26) = "存在风险" Then
      Sheet5.Cells(rng, 27) = "存在风险"
      ElseIf Sheet5.Cells(rng, 18) = "风险低" Or Sheet5.Cells(rng, 19) = "风险低" Or Sheet5.Cells(rng, 20) = "风险低" Or Sheet5.Cells(rng, 21) = "风险低" _
    Or Sheet5.Cells(rng, 22) = "风险低" Or Sheet5.Cells(rng, 24) = "风险低" Or Sheet5.Cells(rng, 25) = "风险低" Or Sheet5.Cells(rng, 26) = "风险低" Then
      Sheet5.Cells(rng, 27) = "风险低"
      End If
    rng = rng + 1
    Loop
End Sub