ナンバーリンク(パズル)を解くVBAに挑戦№7
総仕上げとして、見栄えを良くします。
getBeforeCell
指定位置にくる直前の位置を取得
getAfterCell
指定位置が進んだ直後のを取得
これらを使用し、
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
ここは特に説明の必要はないでしょう。
ナンバーリンク(パズル)を解くVBAに挑戦 ： №1 №2 №3 №4 №5 №6 №7 №8
以下が完成したVBAコードの全てになります。OptionExplicit PrivateSuAry()AsString PrivateSuAry2()AsString PrivateDispRangeAsRange PrivaterMaxAsInteger PrivatecMaxAsInteger PrivateSuAry9(30)AsInteger S…
こちらの最終完成版のダウンロード同じテーマ「マクロVBAサンプル集」の記事
エクセルでファイル一覧を作成
アメブロの記事本文をVBAでバックアップする№6
数独（ナンプレ）を解くVBAに挑戦№5
数独（ナンプレ）を解くアルゴリズムの要点とパフォーマンスの検証№4
ナンバーリンク(パズル)を解くVBAに挑戦№8
ナンバーリンクを解くVBAのパフォーマンス改善№3
オセロを作りながらマクロVBAを学ぼう№9
他ブックへのリンクエラーを探し解除するマクロ（変更前）
Excelシートの複雑な計算式を解析するVBAの関数構文
新着記事NEW ・・・新着記事一覧を見る
Applicationを省略できるApplicationのメソッド・プロパティ一覧｜VBA技術解説（7月22日）
コレクション（Collection）の並べ替え（Sort）に対応するクラス｜VBA技術解説（7月20日）
CSVの読み込み方法（ジャグ配列）｜VBAサンプル集（7月15日）
その他のExcel機能（グループ化、重複の削除、オートフィル等）｜VBA入門（7月14日）
オートフィルタ退避回復クラスを複数シート対応させるVBAクラス｜VBA技術解説（7月6日）
オートフィルタを退避回復するVBAクラス｜VBA技術解説（7月6日）
IfステートメントとIIF関数とMax関数の速度比較｜VBA技術解説（6月23日）
Withステートメントの実行速度と注意点｜VBA技術解説（6月6日）
VBA+SeleniumBasicで検索順位チェッカー（改）｜VBA技術解説（6月2日）
マクロでShift_JIS文字コードか判定する｜VBA技術解説（6月1日）
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜ExcelマクロVBA入門
4.変数とデータ型（Dim）｜ExcelマクロVBA入門
5.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
6.繰り返し処理（For Next)｜ExcelマクロVBA入門
7.マクロって何？VBAって何？｜ExcelマクロVBA入門
8.ExcelマクロVBAの基礎を学習する方法｜エクセルの神髄
9.ひらがな⇔カタカナの変換｜エクセル基本操作
10.セルに文字を入れるとは（Range,Value）｜VBA入門
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。