ナンバーリンク(パズル)を解くVBAに挑戦№8
最後に、枠の大きさを10×10に固定せずに、
Option Explicit
Private SuAry() As String
Private SuAry2() As String
Private DispRange As Range
Private rMax As Integer
Private cMax As Integer
Sub main()
Debug.Print Now()
Dim iR As Integer
Dim iC As Integer
On Error Resume Next
Set DispRange = Application.InputBox(prompt:="問題範囲をドラッグで選択してください。", Title:="問題範囲を選択", Type:=8)
If DispRange Is Nothing Then
Exit Sub
End If
On Error GoTo 0
rMax = DispRange.Rows.Count
cMax = DispRange.Columns.Count
ReDim SuAry(1 To rMax, 1 To cMax)
ReDim SuAry2(1 To rMax, 1 To cMax)
DispRange.NumberFormat = "@"
For iR = 1 To rMax
For iC = 1 To cMax
With DispRange(iR, iC)
If .Value = "" Or Not IsNumeric(.Value) Then
.Value = ""
.Font.Size = 20
.Font.Bold = False
SuAry(iR, iC) = ""
Else
SuAry(iR, iC) = .Value
End If
End With
Next
Next
iR = 1
iC = 0
Call getStart(iR, iC)
Do
If getAdvance(iR, iC, iR, iC, 0) = "完了" Then
Exit Do
End If
Loop
Call dispCell(True)
Debug.Print Now()
End Sub
Private Function getAdvance(ByVal iR As Integer, ByVal iC As Integer, _
ByVal iR2 As Integer, ByVal iC2 As Integer, _
ByVal tryCnt As Integer) As String
Dim iR3 As Integer
Dim iC3 As Integer
Dim iR4 As Integer
Dim iC4 As Integer
Dim i As Integer
Dim strMust As String
Dim rtn As String
Call getEnd(iR4, iC4, SuAry(iR, iC))
Select Case True
Case iR4 = iR2 - 1 And iC4 = iC2, _
iR4 = iR2 And iC4 = iC2 + 1, _
iR4 = iR2 + 1 And iC4 = iC2, _
iR4 = iR2 And iC4 = iC2 - 1
Call dispCell(True)
tryCnt = 0
If getStart(iR, iC) = False Then
getAdvance = "完了"
Exit Function
End If
rtn = getAdvance(iR, iC, iR, iC, tryCnt)
Select Case rtn
Case "完了"
getAdvance = "完了"
Exit Function
Case "終点"
getAdvance = "終点"
tryCnt = 0
If getStart(iR, iC) = False Then
getAdvance = "完了"
Exit Function
End If
Case "破綻"
getAdvance = "破綻"
Exit Function
End Select
End Select
For i = 1 To 4
Select Case True
Case iR4 > iR2 And iC4 > iC2
Select Case i
Case 1
iR3 = iR2 + 1
iC3 = iC2
Case 2
iR3 = iR2
iC3 = iC2 + 1
Case 3
iR3 = iR2 - 1
iC3 = iC2
Case 4
iR3 = iR2
iC3 = iC2 - 1
End Select
Case iR4 > iR2 And iC4 <= iC2
Select Case i
Case 1
iR3 = iR2 + 1
iC3 = iC2
Case 2
iR3 = iR2
iC3 = iC2 - 1
Case 3
iR3 = iR2
iC3 = iC2 + 1
Case 4
iR3 = iR2 - 1
iC3 = iC2
End Select
Case iR4 < iR2 And iC4 > iC2
Select Case i
Case 1
iR3 = iR2 - 1
iC3 = iC2
Case 2
iR3 = iR2
iC3 = iC2 + 1
Case 3
iR3 = iR2 + 1
iC3 = iC2
Case 4
iR3 = iR2
iC3 = iC2 - 1
End Select
Case iR4 = iR2 And iC4 > iC2
Select Case i
Case 1
iR3 = iR2
iC3 = iC2 + 1
Case 2
iR3 = iR2
iC3 = iC2 - 1
Case 3
iR3 = iR2 - 1
iC3 = iC2
Case 4
iR3 = iR2 + 1
iC3 = iC2
End Select
Case iR4 < iR2 And iC4 <= iC2
Select Case i
Case 1
iR3 = iR2 - 1
iC3 = iC2
Case 2
iR3 = iR2
iC3 = iC2 - 1
Case 3
iR3 = iR2 + 1
iC3 = iC2
Case 4
iR3 = iR2
iC3 = iC2 + 1
End Select
Case iR4 = iR2 And iC4 <= iC2
Select Case i
Case 1
iR3 = iR2
iC3 = iC2 - 1
Case 2
iR3 = iR2
iC3 = iC2 + 1
Case 3
iR3 = iR2 - 1
iC3 = iC2
Case 4
iR3 = iR2 + 1
iC3 = iC2
End Select
End Select
If SuAry(1, 1) = "" Then
If (iR2 = 2 And iC2 = 1) Or _
(iR2 = 1 And iC2 = 2) Then
iR3 = 1
iC3 = 1
End If
End If
If SuAry(1, cMax) = "" Then
If (iR2 = 2 And iC2 = cMax) Or _
(iR2 = 1 And iC2 = cMax - 1) Then
iR3 = 1
iC3 = cMax
End If
End If
If SuAry(rMax, 1) = "" Then
If (iR2 = rMax - 1 And iC2 = 1) Or _
(iR2 = rMax And iC2 = 2) Then
iR3 = rMax
iC3 = 1
End If
End If
If SuAry(rMax, cMax) = "" Then
If (iR2 = rMax - 1 And iC2 = cMax) Or _
(iR2 = rMax And iC2 = cMax - 1) Then
iR3 = rMax
iC3 = cMax
End If
End If
If iC3 >= 1 And iC3 <= cMax And iR3 >= 1 And iR3 <= rMax Then
If SuAry(iR3, iC3) = "" Then
If chkAdvance(iR3, iC3, SuAry(iR, iC)) = True Then
If chkClose(iR3, iC3, SuAry(iR, iC)) = True Then
If chkRout(iR, iC) = True Then
tryCnt = tryCnt + 1
Call dispCell(True, iR3, iC3, SuAry(iR, iC) & "-" & tryCnt)
rtn = getAdvance(iR, iC, iR3, iC3, tryCnt)
Select Case rtn
Case "完了"
getAdvance = "完了"
Exit Function
End Select
If Not IsNumeric(SuAry(iR3, iC3)) Then
tryCnt = tryCnt - 1
Call dispCell(True, iR3, iC3, "")
End If
End If
End If
End If
End If
End If
Next
If IsNumeric(SuAry(iR2, iC2)) Then
getAdvance = "破綻"
Else
tryCnt = tryCnt - 1
Call dispCell(True, iR2, iC2, "")
getAdvance = "別ルート探索"
End If
End Function
Private Function chkAdvance(ByVal iR As Integer, ByVal iC As Integer, ByVal i As Integer) As Boolean
Dim cnt As Integer
cnt = 0
If iR <> 1 And iC <> 1 Then
If InStr(SuAry(iR - 1, iC - 1), i & "-") > 0 Or SuAry(iR - 1, iC - 1) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR - 1, iC), i & "-") > 0 Or SuAry(iR - 1, iC) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR, iC - 1), i & "-") > 0 Or SuAry(iR, iC - 1) = CStr(i) Then
cnt = cnt + 1
End If
If cnt >= 3 Then
chkAdvance = False
Exit Function
End If
End If
cnt = 0
If iR <> rMax And iC <> 1 Then
If InStr(SuAry(iR + 1, iC - 1), i & "-") > 0 Or SuAry(iR + 1, iC - 1) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR + 1, iC), i & "-") > 0 Or SuAry(iR + 1, iC) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR, iC - 1), i & "-") > 0 Or SuAry(iR, iC - 1) = CStr(i) Then
cnt = cnt + 1
End If
If cnt >= 3 Then
chkAdvance = False
Exit Function
End If
End If
cnt = 0
If iR <> 1 And iC <> cMax Then
If InStr(SuAry(iR - 1, iC + 1), i & "-") > 0 Or SuAry(iR - 1, iC + 1) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR - 1, iC), i & "-") > 0 Or SuAry(iR - 1, iC) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR, iC + 1), i & "-") > 0 Or SuAry(iR, iC + 1) = CStr(i) Then
cnt = cnt + 1
End If
If cnt >= 3 Then
chkAdvance = False
Exit Function
End If
End If
cnt = 0
If iR <> rMax And iC <> cMax Then
If InStr(SuAry(iR + 1, iC + 1), i & "-") > 0 Or SuAry(iR + 1, iC + 1) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR + 1, iC), i & "-") > 0 Or SuAry(iR + 1, iC) = CStr(i) Then
cnt = cnt + 1
End If
If InStr(SuAry(iR, iC + 1), i & "-") > 0 Or SuAry(iR, iC + 1) = CStr(i) Then
cnt = cnt + 1
End If
If cnt >= 3 Then
chkAdvance = False
Exit Function
End If
End If
chkAdvance = True
End Function
Private Sub dispCell(ByVal blnDisp As Boolean, _
Optional ByVal iR As Integer = 0, Optional ByVal iC As Integer = 0, _
Optional ByVal dispStr As String = "")
Dim i As Integer
Dim j As Integer
Dim bR As Integer
Dim bC As Integer
Dim aR As Integer
Dim aC As Integer
Dim SuAry3() As String
ReDim SuAry3(1 To rMax, 1 To cMax)
If iR <> 0 And iC <> 0 Then
SuAry(iR, iC) = dispStr
End If
If blnDisp = False Then
Exit Sub
End If
For i = 1 To rMax
For j = 1 To cMax
If IsNumeric(SuAry(i, j)) Then
SuAry3(i, j) = SuAry(i, j)
If chkEnd(i, j) = True Then
SuAry2(i, j) = SuAry(i, j) & "-99"
Else
SuAry2(i, j) = SuAry(i, j) & "-0"
End If
Else
SuAry2(i, j) = SuAry(i, j)
End If
Next
Next
For i = 1 To rMax
For j = 1 To cMax
Call getBeforeCell(i, j, bR, bC)
Call getAfterCell(i, j, aR, aC)
If bR <> 0 And bC <> 0 Then
If aR = 0 And aC = 0 Then
SuAry3(i, j) = "◆"
Else
If (aR > i And i > bR) Or _
(aR < i And i < bR) Then
SuAry3(i, j) = "┃"
End If
If (aC > j And j > bC) Or _
(aC < j And j < bC) Then
SuAry3(i, j) = "━"
End If
If (aC > j And i < bR) Or _
(aR > i And j < bC) Then
SuAry3(i, j) = "┏"
End If
If (aC < j And i < bR) Or _
(aR > i And j > bC) Then
SuAry3(i, j) = "┓"
End If
If (aC > j And i > bR) Or _
(aR < i And j < bC) Then
SuAry3(i, j) = "┗"
End If
If (aC < j And i > bR) Or _
(aR < i And j > bC) Then
SuAry3(i, j) = "┛"
End If
End If
End If
Next
Next
DispRange = SuAry3
DoEvents
End Sub
Private Sub getBeforeCell(ByVal iR As Integer, ByVal iC As Integer, ByRef iR2 As Integer, ByRef iC2 As Integer)
Dim i As Integer
Dim j As Integer
Dim n1 As Integer
Dim n2 As Integer
Dim strSu As String
iR2 = 0
iC2 = 2
If SuAry2(iR, iC) = "" Then
Exit Sub
End If
n1 = Split(SuAry2(iR, iC), "-")(0)
n2 = Split(SuAry2(iR, iC), "-")(1)
If n2 = "0" Or n2 = "99" Then
Exit Sub
End If
n2 = n2 - 1
strSu = n1 & "-" & n2
For i = 1 To rMax
For j = 1 To cMax
If SuAry2(i, j) = strSu Then
iR2 = i
iC2 = j
Exit Sub
End If
Next
Next
End Sub
Private Sub getAfterCell(ByVal iR As Integer, ByVal iC As Integer, ByRef iR2 As Integer, ByRef iC2 As Integer)
Dim i As Integer
Dim j As Integer
Dim n1 As Integer
Dim n2 As Integer
Dim strSu As String
iR2 = 0
iC2 = 2
If SuAry2(iR, iC) = "" Then
Exit Sub
End If
n1 = Split(SuAry2(iR, iC), "-")(0)
n2 = Split(SuAry2(iR, iC), "-")(1)
If n2 = "0" Or n2 = "99" Then
Exit Sub
End If
n2 = n2 + 1
strSu = n1 & "-" & n2
For i = 1 To rMax
For j = 1 To cMax
If SuAry(i, j) = strSu Then
iR2 = i
iC2 = j
Exit Sub
End If
Next
Next
strSu = n1 & "-99"
For i = 1 To rMax
For j = 1 To cMax
If SuAry2(i, j) = strSu Then
If (iR = i - 1 And iC = j) Or _
(iR = i And iC = j + 1) Or _
(iR = i + 1 And iC = j) Or _
(iR = i And iC = j - 1) Then
iR2 = i
iC2 = j
Else
iR2 = 0
iC2 = 0
End If
Exit Sub
End If
Next
Next
End Sub
Private Function getStart(ByRef iR As Integer, ByRef iC As Integer) As Boolean
iC = iC + 1
If RowColAjust(iR, iC) = False Then
getStart = False
Exit Function
End If
Do
If IsNumeric(SuAry(iR, iC)) Then
If chkEnd(iR, iC) <> True Then
getStart = True
Exit Function
End If
End If
iC = iC + 1
If RowColAjust(iR, iC) = False Then
getStart = False
Exit Function
End If
Loop
End Function
Private Function RowColAjust(ByRef iR As Integer, ByRef iC As Integer) As Boolean
If iC > cMax Then
iR = iR + 1
iC = 1
End If
If iR > rMax Then
RowColAjust = False
Exit Function
End If
RowColAjust = True
End Function
Private Function chkEnd(ByVal iR As Integer, ByVal iC As Integer) As Boolean
Dim iR2 As Integer
Dim iC2 As Integer
Call getEnd(iR2, iC2, SuAry(iR, iC))
If iR2 = iR And iC2 = iC Then
chkEnd = True
Else
chkEnd = False
End If
End Function
Private Sub getEnd(ByRef iR2 As Integer, ByRef iC2 As Integer, ByVal i As String)
iR2 = rMax
iC2 = cMax
Do
If SuAry(iR2, iC2) = i Then
Exit Sub
End If
iC2 = iC2 - 1
If iC2 < 1 Then
iR2 = iR2 - 1
iC2 = cMax
End If
If iR2 < 1 Then
Exit Sub
End If
Loop
End Sub
Private Function chkRout(ByVal iR1 As Integer, ByVal iC1 As Integer) As Boolean
Dim iR2 As Integer
Dim iC2 As Integer
Dim iR3 As Integer
Dim iC3 As Integer
Dim i As Integer
Dim j As Integer
chkRout = True
For i = 1 To rMax
For j = 1 To cMax
SuAry2(i, j) = SuAry(i, j)
Next
Next
If getStart(iR1, iC1) = False Then
chkRout = True
Exit Function
End If
Call getEnd(iR2, iC2, SuAry(iR1, iC1))
If chkRout2(iR1, iC1, iR2, iC2) = False Then
chkRout = False
End If
If chkRout(iR1, iC1) = False Then
chkRout = False
End If
End Function
Private Function chkRout2(ByVal iR1 As Integer, ByVal iC1 As Integer, ByVal iR2 As Integer, ByVal iC2 As Integer) As Boolean
Dim i As Integer
Dim iR3 As Integer
Dim iC3 As Integer
Select Case True
Case iR1 = iR2 - 1 And iC1 = iC2, _
iR1 = iR2 And iC1 = iC2 + 1, _
iR1 = iR2 + 1 And iC1 = iC2, _
iR1 = iR2 And iC1 = iC2 - 1
chkRout2 = True
Exit Function
End Select
For i = 1 To 4
Select Case i
Case 1
iR3 = iR2 + 1
iC3 = iC2
Case 2
iR3 = iR2
iC3 = iC2 + 1
Case 3
iR3 = iR2 - 1
iC3 = iC2
Case 4
iR3 = iR2
iC3 = iC2 - 1
End Select
If iC3 >= 1 And iC3 <= cMax And iR3 >= 1 And iR3 <= rMax Then
If SuAry2(iR3, iC3) = "" Then
SuAry2(iR3, iC3) = "●"
If chkRout2(iR1, iC1, iR3, iC3) = True Then
chkRout2 = True
Exit Function
End If
End If
End If
Next
chkRout2 = False
End Function
Private Function chkClose(ByVal iR1 As Integer, ByVal iC1 As Integer, ByVal iNo As Integer) As Boolean
Dim iR2 As Integer
Dim iC2 As Integer
Dim cnt As Integer
Dim i As Integer
Dim j As Integer
chkClose = True
For i = 1 To rMax
For j = 1 To cMax
SuAry2(i, j) = SuAry(i, j)
Next
Next
SuAry2(iR1, iC1) = "●"
cnt = 0
If iR1 > 1 Then
If SuAry2(iR1 - 1, iC1) = "" Then
If chkClose3(iR1 - 1, iC1, iNo) = False Then
chkClose = False
Exit Function
End If
Call chkClose2(iR1 - 1, iC1, cnt, iNo)
If cnt <= 1 Then
chkClose = False
Exit Function
End If
End If
End If
For i = 1 To rMax
For j = 1 To cMax
SuAry2(i, j) = SuAry(i, j)
Next
Next
SuAry2(iR1, iC1) = "●"
cnt = 0
If iR1 < rMax Then
If SuAry2(iR1 + 1, iC1) = "" Then
If chkClose3(iR1 + 1, iC1, iNo) = False Then
chkClose = False
Exit Function
End If
Call chkClose2(iR1 + 1, iC1, cnt, iNo)
If cnt <= 1 Then
chkClose = False
Exit Function
End If
End If
End If
For i = 1 To rMax
For j = 1 To cMax
SuAry2(i, j) = SuAry(i, j)
Next
Next
SuAry2(iR1, iC1) = "●"
cnt = 0
If iC1 > 1 Then
If SuAry2(iR1, iC1 - 1) = "" Then
If chkClose3(iR1, iC1 - 1, iNo) = False Then
chkClose = False
Exit Function
End If
Call chkClose2(iR1, iC1 - 1, cnt, iNo)
If cnt <= 1 Then
chkClose = False
Exit Function
End If
End If
End If
For i = 1 To rMax
For j = 1 To cMax
SuAry2(i, j) = SuAry(i, j)
Next
Next
SuAry2(iR1, iC1) = "●"
cnt = 0
If iC1 < cMax Then
If SuAry2(iR1, iC1 + 1) = "" Then
If chkClose3(iR1, iC1 + 1, iNo) = False Then
chkClose = False
Exit Function
End If
Call chkClose2(iR1, iC1 + 1, cnt, iNo)
If cnt <= 1 Then
chkClose = False
Exit Function
End If
End If
End If
End Function
Private Sub chkClose2(ByVal iR1 As Integer, ByVal iC1 As Integer, ByRef cnt As Integer, ByVal iNo As Integer)
Dim i As Integer
Dim iR3 As Integer
Dim iC3 As Integer
If cnt >= 2 Then
Exit Sub
End If
For i = 1 To 4
Select Case i
Case 1
iR3 = iR1 + 1
iC3 = iC1
Case 2
iR3 = iR1
iC3 = iC1 + 1
Case 3
iR3 = iR1 - 1
iC3 = iC1
Case 4
iR3 = iR1
iC3 = iC1 - 1
End Select
If iC3 >= 1 And iC3 <= cMax And iR3 >= 1 And iR3 <= rMax Then
If SuAry2(iR3, iC3) = "" Then
SuAry2(iR3, iC3) = "●"
Call chkClose2(iR3, iC3, cnt, iNo)
Else
If SuAry2(iR3, iC3) = CStr(iNo) Then
cnt = 2
Exit Sub
End If
If IsNumeric(SuAry2(iR3, iC3)) Then
SuAry2(iR3, iC3) = "●"
cnt = cnt + 1
If cnt >= 2 Then
Exit Sub
End If
End If
End If
End If
Next
End Sub
Private Function chkClose3(ByVal iR1 As Integer, ByVal iC1 As Integer, ByVal iNo As Integer) As Boolean
Dim cnt As Integer
Dim i As Integer
Dim j As Integer
chkClose3 = True
If (iR1 = 1 Or iR1 = rMax) And (iC1 = 1 Or iC1 = cMax) Then
chkClose3 = True
Exit Function
End If
cnt = 0
If iR1 > 1 Then
If SuAry2(iR1 - 1, iC1) = "" Then
cnt = cnt + 1
End If
If IsNumeric(SuAry2(iR1 - 1, iC1)) Then
chkClose3 = True
Exit Function
End If
If SuAry2(iR1 - 1, iC1) <> "●" And InStr(SuAry2(iR1 - 1, iC1), "-") > 0 Then
If Split(SuAry2(iR1 - 1, iC1), "-")(0) <> CStr(iNo) Then
chkClose3 = True
Exit Function
End If
End If
End If
If iR1 < rMax Then
If SuAry2(iR1 + 1, iC1) = "" Then
cnt = cnt + 1
End If
If IsNumeric(SuAry2(iR1 + 1, iC1)) Then
chkClose3 = True
Exit Function
End If
If SuAry2(iR1 + 1, iC1) <> "●" And InStr(SuAry2(iR1 + 1, iC1), "-") > 0 Then
If Split(SuAry2(iR1 + 1, iC1), "-")(0) <> CStr(iNo) Then
chkClose3 = True
Exit Function
End If
End If
End If
If iC1 > 1 Then
If SuAry2(iR1, iC1 - 1) = "" Then
cnt = cnt + 1
End If
If IsNumeric(SuAry2(iR1, iC1 - 1)) Then
chkClose3 = True
Exit Function
End If
If SuAry2(iR1, iC1 - 1) <> "●" And InStr(SuAry2(iR1, iC1 - 1), "-") > 0 Then
If Split(SuAry2(iR1, iC1 - 1), "-")(0) <> CStr(iNo) Then
chkClose3 = True
Exit Function
End If
End If
End If
If iC1 < cMax Then
If SuAry2(iR1, iC1 + 1) = "" Then
cnt = cnt + 1
End If
If IsNumeric(SuAry2(iR1, iC1 + 1)) Then
chkClose3 = True
Exit Function
End If
If SuAry2(iR1, iC1 + 1) <> "●" And InStr(SuAry2(iR1, iC1 + 1), "-") > 0 Then
If Split(SuAry2(iR1, iC1 + 1), "-")(0) <> CStr(iNo) Then
chkClose3 = True
Exit Function
End If
End If
End If
If cnt <= 1 Then
chkClose3 = False
End If
End Function
今回はここまでになります。
速度改善しました「ナンバーリンクを解くVBAのパフォーマンス改善」
ナンバーリンク(パズル)を解くVBAに挑戦 : №1 №2 №3 №4 №5 №6 №7 №8
同じテーマ「マクロVBAサンプル集」の記事
アメブロの記事本文をVBAでバックアップする№1
数独(ナンプレ)を解くVBAに挑戦№1
数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証№1
ナンバーリンク(パズル)を解くVBAに挑戦№1
ナンバーリンクを解くVBAのパフォーマンス改善№1
オセロを作りながらマクロVBAを学ぼう
他ブックへのリンクエラーを探し解除
Excelシートの複雑な計算式を解析するVBA
Excel将棋:マクロVBAの学習用(№1)
Excel囲碁:万波奈穂先生に捧ぐ
Excel囲碁:再起動後も続けて打てるように改造
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.繰り返し処理(For Next)|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.変数宣言のDimとデータ型|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.条件分岐(Select Case)|VBA入門
10.ブック・シートの選択(Select,Activate)|VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- ナンバーリンク(パズル)を解くVBAに挑戦№8
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。