|
楼主 |
发表于 2015-8-14 10:30
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Function RC_RANGE(ByVal r As Integer, ByVal c As Integer, ByVal p As Integer) As Boolean '判断是否可填入数字,p为将要填写的数字
- Dim a1, a2, a3 As Integer
- Dim Result1 As Boolean
- a1 = 0 '标记宫是否可填入
- a2 = 0 '标记r行是否可填入
- a3 = 0 '标记宫c列否可填入
- '1
- If 1 <= r And r <= 3 And 1 <= c And c <= 3 Then '1宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("A1:C3"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '2
- If 1 <= r And r <= 3 And 4 <= c And c <= 6 Then '2宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("D1:F3"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '3
- If 1 <= r And r <= 3 And 7 <= c And c <= 9 Then '3宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("G1:I3"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '4
- If 4 <= r And r <= 6 And 1 <= c And c <= 3 Then '4宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("A4:C6"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '5
- If 4 <= r And r <= 6 And 4 <= c And c <= 6 Then '5宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("D4:F6"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '6
- If 4 <= r And r <= 6 And 7 <= c And c <= 9 Then '6宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("G4:I6"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '7
- If 7 <= r And r <= 9 And 1 <= c And c <= 3 Then '7宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("A7:C9"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '8
- If 7 <= r And r <= 9 And 4 <= c And c <= 6 Then '8宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("D7:F9"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- '9
- If 7 <= r And r <= 9 And 7 <= c And c <= 9 Then '9宫
- a1 = Application.WorksheetFunction.CountIf(Sheet1.Range("G7:I9"), p)
- a2 = Application.WorksheetFunction.CountIf(Sheet1.Range("A" & r & ":" & "I" & r), p)
- a3 = Application.WorksheetFunction.CountIf(Sheet1.Range(Mid(Cells(r, c).Address, 2, 1) & "1" & ":" & Mid(Cells(r, c).Address, 2, 1) & "9"), p)
- If (a1 + a2 + a3) = 0 Then
- RC_RANGE = True
- Else
- RC_RANGE = False
- End If
- End If
- Result1 = RC_RANGE
- '判断返回的结果,如果结果为假,说明当前数字不可填入,继续填写下一个数字直到9
- '如果结果为真,则填入当前数字,并在sheet2中记录当前单元格的行列和填写的值
- '如果到9也不可填入,说明无解
- If Result1 = False Then '如果结果为假,即当前数字不可填入,则数字p加1,回调直到9为止
- p = p + 1
- 'If p = 10 Then '说明没有数字可以填写,让程序返回上一个格子重新填写
- 'RC_RANGE = False
- 'Exit Function
- 'Sheet3.Range("E1").Value = Sheet3.Range("E1").Value - 1
- 'm = Sheet3.Range("E1").Value
- 'r = Sheet3.Cells(m, 1)
- 'c = Sheet3.Cells(m, 2)
- 'p = Sheet3.Cells(m, 3)
- 'Sheet3.Range("a" & p & ":" & "c" & p).ClearContents '清除当前缓存队列
- 'Sheet1.Cells(r, c).ClearContents
- 'If m = 1 And Sheet3.Range("E2").Value = 1 Then
- ' Result1 = False
- ' Exit Function
- 'End If
- 'Result1 = RC_RANGE(r, c, p + 1) '此处p可能会增加到10,需要判断此类情况
- 'End If
- Result1 = RC_RANGE(r, c, p)
- ElseIf Result1 = True And p <> 10 Then '结果为真,填写数字并记录行列和值的信息,并结束次过程,并返回结果真,让住程序填写下一个格子
- Sheet1.Cells(r, c) = p '填写数字
- Sheet3.Cells(Sheet3.Range("E1").Value, 1) = r '记录行
- Sheet3.Cells(Sheet3.Range("E1").Value, 2) = c '记录列
- Sheet3.Cells(Sheet3.Range("E1").Value, 3) = p '记录填写的值
- Sheet3.Range("E1") = Sheet3.Range("E1").Value + 1
- Sheet3.Range("E2") = 1
- 'RC_RANGE = True
- Exit Function
- ElseIf Result1 = True And p = 10 Then '在第一次为假的时候,可能P会加到10,所以要判断这种情况
- Sheet3.Range("E1").Value = Sheet3.Range("E1").Value - 1
- m = Sheet3.Range("E1").Value
- r = Sheet3.Cells(m, 1)
- c = Sheet3.Cells(m, 2)
- p = Sheet3.Cells(m, 3)
- Sheet3.Range("a" & m & ":" & "c" & m).ClearContents '清除当前缓存队列
- Sheet1.Cells(r, c).ClearContents
- If m = 1 And Sheet3.Range("E2").Value = 1 Then
- Result1 = False
- Exit Function
- End If
- Result1 = RC_RANGE(r, c, p + 1)
- End If
- RC_RANGE = Result1
- End Function
复制代码
发现模块的代码没贴上,现在重贴 |
|