ナンバーリンク(パズル)を解く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コードの全てになります。10×18で、18分 12×12で、16分 という結果となりました。もちろん、時間はたまたまテストした問題における時間です。解けるまでの時間は問題に大きく左右されますので、あくまで目安です。
こちらの最終完成版のダウンロード同じテーマ「マクロVBAサンプル集」の記事
エクセルでファイル一覧を作成
アメブロの記事本文をVBAでバックアップする№6
数独（ナンプレ）を解くVBAに挑戦№5
数独（ナンプレ）を解くアルゴリズムの要点とパフォーマンスの検証№4
ナンバーリンク(パズル)を解くVBAに挑戦№8
ナンバーリンクを解くVBAのパフォーマンス改善№3
オセロを作りながらマクロVBAを学ぼう
他ブックへのリンクエラーを探し解除するマクロ（変更前）
Excelシートの複雑な計算式を解析するVBAの関数構文
新着記事NEW ・・・新着記事一覧を見る
VBAでのCSVの扱い方まとめ｜VBAサンプル集（11月9日）
VBAにおける変数のメモリアドレスについて｜VBA技術解説（11月8日）
空文字列の扱い方と処理速度について（""とvbNullString）｜VBA技術解説（1月7日）
Errオブジェクトとユーザー定義エラー｜VBA入門（11月5日）
シングルクォートの削除とコピー（PrefixCharacter）｜VBA技術解説（11月4日）
ユーザー定義型の制限とクラスとの使い分け｜VBA技術解説（11月3日）
クリップボードに2次元配列を作成してシートに貼り付ける｜VBA技術解説（11月1日）
VBAクラスを使ったイベント作成（Event,RaiseEvent,WithEvents）｜VBA技術解説（10月31日）
VBAクラスのAttributeについて（既定メンバーとFor Each）｜VBA技術解説（10月19日）
VBAの用語について：ステートメントとは｜VBA技術解説（10月16日）
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜ExcelマクロVBA入門
4.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
5.変数宣言のDimとデータ型｜ExcelマクロVBA入門
6.繰り返し処理（For Next)｜ExcelマクロVBA入門
7.マクロって何？VBAって何？｜ExcelマクロVBA入門
8.ひらがな⇔カタカナの変換｜エクセル基本操作
9.空白セルを正しく判定する方法（IsEmpty,IsError,HasFormula）｜VBA技術解説
10.セルに文字を入れるとは（Range,Value）｜VBA入門
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。