|
本帖最后由 哗英雄 于 2014-5-19 09:18 编辑
'sheetname 表格名称
'chklen 验证数据有效性单元格行数
'功能:验证sheetname表格中连续有效性chklen围中最佳值,
'判断方式:以验证数据中单元格底色为依据,3个单元格中的底色一致则表明该行数据没有围中
'为提高验证速度,所有验证都是O-Q列,其它无效
Function fn_getDefaultValue(sheetname As String, chklen As Integer)
Worksheets(sheetname).Select
'最大开奖对应行号
Dim maxrow As Integer
Dim arr(0 To 33) As Integer
Dim returnvalue As Integer
maxrow = 0
For i = 5 To 65535 Step 1
If Worksheets(sheetname).Range("A" & i) = "" Then
Exit For
End If
maxrow = i
Next
'因为表数据最后一行有开奖期号却没有开奖数据
maxrow = maxrow - 1
'没围中个数标识
Dim temp, arrindex As Integer
arrindex = 0
For i = 0 To 33
arr(i) = 0
'预设条件设定值,令其自动更新围条件数据
arrindex = i
Worksheets(sheetname).Range("R1") = arrindex
'计算围中个数,如果全部围中则循环结束计算(已找到最佳条件范围)
temp = 0
For J = 0 To chklen - 1 Step 1
With Worksheets(sheetname)
If Application.WorksheetFunction.CountIf(Range("O" & CStr(maxrow - J) & ":" & "Q" & CStr(maxrow - J)), Range("I" & CStr(maxrow - J))) + Application.WorksheetFunction.CountIf(Range("O" & CStr(maxrow - J) & ":" & "Q" & CStr(maxrow - J)), Range("J" & CStr(maxrow - J))) + Application.WorksheetFunction.CountIf(Range("O" & CStr(maxrow - J) & ":" & "Q" & CStr(maxrow - J)), Range("K" & CStr(maxrow - J))) + Application.WorksheetFunction.CountIf(Range("O" & CStr(maxrow - J) & ":" & "Q" & CStr(maxrow - J)), Range("L" & CStr(maxrow - J))) + Application.WorksheetFunction.CountIf(Range("O" & CStr(maxrow - J) & ":" & "Q" & CStr(maxrow - J)), Range("M" & CStr(maxrow - J))) + Application.WorksheetFunction.CountIf(Range("O" & CStr(maxrow - J) & ":" & "Q" & CStr(maxrow - J)), Range("N" & CStr(maxrow - J))) <= 0 Then
temp = temp + 1
End If
End With
' If Application.WorksheetFunction.CountIf(Worksheets(sheetname).Range("I" & CStr(maxrow - J) & ":" & "N" & CStr(maxrow - J)), Worksheets(sheetname).Range("O" & CStr(maxrow - J) & ":" & "S" & CStr(maxrow - J))) <= 0 Then
' temp = temp + 1
' End If
Next
If temp = 0 Then
GoTo 0
Else
arr(i) = temp
End If
Next
temp = arr(0)
arrindex = 0
For i = 1 To 9 Step 1
If arr(i) < temp Then
temp = arr(i)
arrindex = i
End If
Next
0:
fn_getDefaultValue = arrindex
End Function
三码B.zip (425 KB, 下载次数: 0) 上面的这是判断固定范围内对的,我想把它改为判断固定范围内错的,应该怎样改,谢谢
|
|
|