下面是编程之家 jb51.cc 通过网络收集整理的代码片段。
编程之家小编现在分享给大家，也给大家做个参考。
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Option Explicit
' 機能：取得数字
' 引数：基礎値、行数、列数
Public Function getValOfRowCol(baseVal As Integer,rowNo As Integer,colNo As Integer) As Integer
Dim val As Integer
getValOfRowCol = 0
If Cells(rowNo,colNo) = "" Then
'空白
For val = baseVal To 9
If checkRow(val,rowNo) = 0 Then
If checkCol(val,colNo) = 0 Then
If checkBlock(val,rowNo,colNo) = 0 Then
getValOfRowCol = val
Exit For
End If
End If
End If
Next val
End If
End Function
Sub go()
Dim rel As Integer
'
rel = setNextValFromRowCol(2,2)
MsgBox "結果：" & rel
End Sub
Function setNextValFromRowCol(fromRow As Integer,fromCol As Integer) As Integer
'OK:0 NG:1
Dim val As Integer
Dim NextRow As Integer
Dim NextCol As Integer
Dim baseVal As Integer
If fromRow = 11 Then
MsgBox "OK、完了！"
End
End If
If Cells(fromRow,fromCol).Font.Size = 26 Then
'固有数字
'次のセルを探す
'If fromCol = 10 Then
' NextRow = fromRow + 1
' NextCol = 2
'Else
' NextRow = fromRow
' NextCol = fromCol + 1
'End If
Call getBestRowCol(NextRow,NextCol)
If NextRow = 0 Then
MsgBox "完了！"
End
End If
If setNextValFromRowCol(NextRow,NextCol) = 0 Then
setNextValFromRowCol = 0
Else
setNextValFromRowCol = 1
End If
Else
'現在値をセットする
For baseVal = 1 To 9
val = getValOfRowCol(baseVal,fromRow,fromCol)
If val <> 0 Then
Cells(fromRow,fromCol) = val
'次のセルを探す
'If fromCol = 10 Then
' NextRow = fromRow + 1
' NextCol = 2
'Else
' NextRow = fromRow
' NextCol = fromCol + 1
'End If
Call getBestRowCol(NextRow,NextCol)
If NextRow = 0 Then
MsgBox "完了！"
End
End If
If setNextValFromRowCol(NextRow,NextCol) = 1 Then
Cells(fromRow,fromCol) = ""
setNextValFromRowCol = 1
End If
baseVal = val
Else
setNextValFromRowCol = 1
Exit For
End If
Next baseVal
End If
End Function
'行合理性チェック(0:OK,1:NG)
Function checkRow(val,rowNo)
Dim col As Integer
Dim flg As Integer
flg = 0
For col = 2 To 10
If val = Cells(rowNo,col) Then
flg = 1
End If
If flg = 1 Then Exit For
Next col
checkRow = flg
End Function
'列合理性チェック(0:OK,1:NG)
Function checkCol(val,colNo)
Dim row As Integer
Dim flg As Integer
flg = 0
For row = 2 To 10
If val = Cells(row,colNo) Then
flg = 1
End If
If flg = 1 Then Exit For
Next row
checkCol = flg
End Function
'BLOCK合理性チェック(0:OK,1:NG)
Function checkBlock(val,colNo)
Dim row As Integer
Dim col As Integer
Dim brow As Integer
Dim bcol As Integer
Dim flg As Integer
flg = 0
brow = Fix((rowNo - 2) / 3)
bcol = Fix((colNo - 2) / 3)
If brow < 0 Then brow = 0
If bcol < 0 Then bcol = 0
For row = 1 To 3
For col = 1 To 3
If val = Cells(brow * 3 + row + 1,bcol * 3 + col + 1) Then
flg = 1
End If
If flg = 1 Then Exit For
Next col
If flg = 1 Then Exit For
Next row
checkBlock = flg
End Function
'最優先するセルを選択
Function getBestRowCol(ByRef retRow As Integer,ByRef retCol As Integer)
Dim row As Integer
Dim col As Integer
Dim valSpace As Integer '空白評価値
Dim minValSpace As Integer
retRow = 0
retCol = 0
minValSpace = 9999
For row = 2 To 10
For col = 2 To 10
If Cells(row,col) = "" Then
valSpace = cntspace(row,col)
If valSpace < minValSpace And valSpace > 0 Then
retRow = row
retCol = col
minValSpace = valSpace
End If
End If
Next col
Next row
End Function
Function cntspace(row As Integer,col As Integer) As Integer
'セル所在場所の空白数計算
Dim rowSpace As Integer
Dim colSpace As Integer
Dim blkSpace As Integer
Dim val As Integer
'所在行数の空白数
rowSpace = cntRowSpace(row)
colSpace = cntColSpace(col)
blkSpace = cntBlkSpace(row,col)
val = rowSpace
If colSpace < val Then val = colSpace
If blkSpace < val Then val = blkSpace
cntspace = val
End Function
'行空数を計算
Function cntRowSpace(row As Integer) As Integer
Dim col As Integer
Dim cnt As Integer
cnt = 0
For col = 2 To 10
If Cells(row,col) = "" Then
cnt = cnt + 1
End If
Next col
cntRowSpace = cnt
End Function
'列空数を計算
Function cntColSpace(col As Integer) As Integer
Dim row As Integer
Dim cnt As Integer
cnt = 0
For row = 2 To 10
If Cells(row,col) = "" Then
cnt = cnt + 1
End If
Next row
cntColSpace = cnt
End Function
'Block空数を計算
Function cntBlkSpace(row As Integer,col As Integer) As Integer
Dim cnt As Integer
Dim rblock As Integer
Dim cblock As Integer
Dim i As Integer
Dim j As Integer
cnt = 0
rblock = Fix((row - 2) / 3)
cblock = Fix((col - 2) / 3)
For i = 1 To 3
For j = 1 To 3
If Cells(rblock * 3 + i + 1,cblock * 3 + j + 1) = "" Then
cnt = cnt + 1
End If
Next j
Next i
cntBlkSpace = cnt
End Function
以上是编程之家(jb51.cc)为你收集整理的全部代码内容，希望文章能够帮你解决所遇到的程序开发问题。
如果觉得编程之家网站内容还不错，欢迎将编程之家网站推荐给程序员好友。
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。