Sub Sample3()
Dim Target As String, i As Long, buf As String, c
Target = InputBox("年度を指定してください")
If Target = "" Then Exit Sub
For i = 2 To 9
If Left(Cells(i, 1), 4) = Target Then
buf = Target & "(" & Cells(i, 1).Address(0, 0) & ")" & vbCrLf
buf = buf & "----------" & vbCrLf
For Each c In Cells(i, 1).MergeArea
buf = buf & c.Address(0, 0) & vbCrLf
Next c
MsgBox buf
Exit For
End If
Next i
End Sub
Sub Sample4()
Dim buf As String
With Range("A1").MergeArea
buf = buf & .Rows.Count & "行" & vbCrLf
buf = buf & .Columns.Count & "列" & vbCrLf
buf = buf & .Count & "個" & vbCrLf
buf = buf & .Item(1).Address(0, 0) & ":左上" & vbCrLf
buf = buf & .Item(.Count).Address(0, 0) & ":右下"
End With
MsgBox buf
End Sub
Sub Sample5()
Dim Target As String, i As Long, buf As String, c
Target = InputBox("年度を指定してください")
If Target = "" Then Exit Sub
For i = 2 To 9
If Left(Cells(i, 1), 4) = Target Then
buf = Target & "年の受賞者は、" & vbCrLf
For Each c In Cells(i, 1).MergeArea
buf = buf & c.Offset(0, 1) & "さん" & vbCrLf
Next c
MsgBox buf
Exit For
End If
Next i
End Sub
Sub Sample1()
Range("A1:C4").Borders.LineStyle = True
End Sub
Sub Sample2()
If Application.Intersect(ActiveCell, Range("B2:D5")) Is Nothing Then
MsgBox ActiveCell.Address(False, False) & "は" & vbCrLf & _
"セル範囲B2:D5の外です"
Else
MsgBox ActiveCell.Address(False, False) & "は" & vbCrLf & _
"セル範囲B2:D5の中です"
End If
End Sub
Sub Sample4()
Dim myRange As AutoFilter
Set myRange = ActiveSheet.AutoFilter
If Not myRange Is Nothing Then
MsgBox "設定されています"
Else
MsgBox "設定されていません"
End If
End Sub
正解は「セルに設定されている表示形式によって異なる」です。
もし、元のセル範囲A1:A5に「文字列」の表示形式が設定されていた場合は、"001"や"002"などが、文字列として代入されます。このとき、"001"や"002"を、"1"や"2"など純粋な数値として表示したいのでしたら、代入するときに、表示形式も変更してやります。
Sub Sample2()
Dim i As Long
For i = 1 To 5
With Cells(i, 1)
.NumberFormat = "General"
.Value = Mid(.Value, 2)
End With
Next i
End Sub
あるいは、オートフィルタを設定したい表内の、どれか1つのセルを指定すれば、Excelが自動的に表の大きさを認識してくれますので、次のように書いてもOKです。
Range("A1").AutoFilter Field:=1, Criteria1:="田中"
Sub Sample2()
Dim PathName As String, FileName As String, pos As Long
pos = InStrRev("C:\Sample\Sub\Book1.xls", "\")
PathName = Left("C:\Sample\Sub\Book1.xls", pos)
FileName = Mid("C:\Sample\Sub\Book1.xls", pos + 1)
MsgBox PathName & vbCrLf & FileName
End Sub