|
- Sub P值范围判断fox()
- Dim xRg As Range, fArr(), xArr(), SC, WR%, HC%, fNu%, i%, j%
- Application.ScreenUpdating = False
- With Sheet1
- fArr = .Range("A1").Resize(78, 15).Value
- Set xRg = .Range("Q1").Resize(.Cells(.Rows.Count, 17).End(xlUp).Row, 4)
- xArr = xRg.Value
- End With
- For i = 1 To UBound(xArr, 1)
- SC = Switch(xArr(i, 1) = "男", 2, xArr(i, 1) = "女", 9)
- If SC Then
- WR = UBound(fArr, 1)
- For j = 3 To UBound(fArr, 1)
- If xArr(i, 3) <= Val(fArr(j, 1)) Then: WR = j: Exit For
- Next
- HC = SC + 6
- For j = 0 To 6
- If xArr(i, 2) <= Val(fArr(WR, SC + j)) Then: HC = SC + j: Exit For
- Next
- xArr(i, 4) = fArr(2, HC)
- fNu = fNu + 1
- End If
- Next
- xRg.Value = xArr
- Application.ScreenUpdating = True
- MsgBox "完成 " & fNu & " 组P值范围判断!"
- End Sub
复制代码
|
|