ナンバーリンク(パズル)を解くVBAに挑戦№7
総仕上げとして、見栄えを良くします。
ちゃんと、数字と数字が線でつながっているようにします。
dispCell
これを拡張します。
getBeforeCell
指定位置にくる直前の位置を取得
getAfterCell
指定位置が進んだ直後のを取得
これらを使用し、
dispCell
の中で、線にしていきます。
では、これを組み込んだコードです。
| Option Explicit Private SuAry(1 To 10, 1 To 10) As String Private SuAry2(1 To 10, 1 To 10) As String Private DispRange As Range Sub main() Debug.Print Now() Dim iR As Integer Dim iC As Integer Set DispRange = Range("B2:K11") DispRange.NumberFormat = "@" For iR = 1 To 10 For iC = 1 To 10 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, 10) = "" Then If (iR2 = 2 And iC2 = 10) Or _ (iR2 = 1 And iC2 = 9) Then iR3 = 1 iC3 = 10 End If End If If SuAry(10, 1) = "" Then If (iR2 = 9 And iC2 = 1) Or _ (iR2 = 10 And iC2 = 2) Then iR3 = 10 iC3 = 1 End If End If If SuAry(10, 10) = "" Then If (iR2 = 9 And iC2 = 10) Or _ (iR2 = 10 And iC2 = 9) Then iR3 = 10 iC3 = 10 End If End If If iC3 >= 1 And iC3 <= 10 And iR3 >= 1 And iR3 <= 10 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 <> 10 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 <> 10 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 <> 10 And iC <> 10 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(1 To 10, 1 To 10) As String 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 10 For j = 1 To 10 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 10 For j = 1 To 10 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 10 For j = 1 To 10 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 10 For j = 1 To 10 If SuAry(i, j) = strSu Then iR2 = i iC2 = j Exit Sub End If Next Next strSu = n1 & "-99" For i = 1 To 10 For j = 1 To 10 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 > 10 Then iR = iR + 1 iC = 1 End If If iR > 10 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 = 10 iC2 = 10 Do If SuAry(iR2, iC2) = i Then Exit Sub End If iC2 = iC2 - 1 If iC2 < 1 Then iR2 = iR2 - 1 iC2 = 10 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 10 For j = 1 To 10 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 <= 10 And iR3 >= 1 And iR3 <= 10 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 10 For j = 1 To 10 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 10 For j = 1 To 10 SuAry2(i, j) = SuAry(i, j) Next Next SuAry2(iR1, iC1) = "●" cnt = 0 If iR1 < 10 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 10 For j = 1 To 10 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 10 For j = 1 To 10 SuAry2(i, j) = SuAry(i, j) Next Next SuAry2(iR1, iC1) = "●" cnt = 0 If iC1 < 10 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 <= 10 And iR3 >= 1 And iR3 <= 10 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 = 10) And (iC1 = 1 Or iC1 = 10) 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 < 10 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 < 10 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 |
ここは特に説明の必要はないでしょう。
シートへの表示のためのロジックが結構面倒でしたね、
処理時間も、約3分半くらいになってます、まあ許容範囲内でしょうか。
いやー、作り始めたときは、なんとかなるだろうと思っていたのですが・・・
途中挫折しかけました、いや、挫折しました。
少し間をおいてから再挑戦したりを2回ほど繰り返して、なんとかたどり着けました。
完全に趣味の範囲ですし、これが出来たからといって、何だということもありません。
VBAの腕試しと、あたまの体操、そして問題解決能力を磨く
まあ、そんなところでしょうか。
時間のある方は、いろいろなパズルを解くVBA作りに挑戦してみてください。
最後に、10×10以外でも解けるようにRange範囲指定を可変にし、
汎用で使えるように修正したものを紹介しておきます。
№8へ続きます。
ナンバーリンク(パズル)を解くVBAに挑戦 ： №1 №2 №3 №4 №5 №6 №7 №8
※ナンバーリンクを解くVBAのパフォーマンス改善
こちらの最終完成版のダウンロード
同じテーマ「マクロVBAサンプル集」の記事
エクセルでファイル一覧を作成
アメブロの記事本文をVBAでバックアップする№1
数独（ナンプレ）を解くVBAに挑戦№1
数独（ナンプレ）を解くアルゴリズムの要点とパフォーマンスの検証№1
ナンバーリンク(パズル)を解くVBAに挑戦№1
ナンバーリンクを解くVBAのパフォーマンス改善№1
オセロを作りながらマクロVBAを学ぼう
新着記事 ・・・新着記事一覧を見る
エクセルVBAでのシート指定方法｜VBA技術解説（9月8日）
VBAのクラスとは（Class,Property,Get,Let,Set）｜VBA技術解説（8月28日）
VBAこれだけは覚えておきたい必須基本例文10｜VBA技術解説（8月22日）
VBAの省略可能な記述について｜ExcelマクロVBA技術解説（8月11日）
複数条件判定を行う時のコツ｜ExcelマクロVBA技術解説（7月11日）
For Next の使い方いろいろ｜VBA技術解説（6月14日）
VBAを定型文で覚えよう｜ExcelマクロVBA技術解説（3月26日）
VBAスタンダード試験対策まとめ｜MOS VBAエキスパート対策（3月16日）
ユーザーフォームとメニューの操作｜MOS VBAエキスパート対策（3月14日）
ファイルの操作｜MOS VBAエキスパート対策（3月14日）
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.変数とデータ型（Dim）｜ExcelマクロVBA入門
4.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
5.RangeとCellsの使い方｜ExcelマクロVBA入門
6.定数と型宣言文字（Const）｜ExcelマクロVBA入門
7.マクロって何？VBAって何？｜ExcelマクロVBA入門
8.とにかく書いて見よう（Sub,End Sub）｜VBA入門
9.繰り返し処理（For Next)｜ExcelマクロVBA入門
10.ひらがな⇔カタカナの変換｜エクセル基本操作
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。
