Contents
表形式
アクティブセル領域
特定セルを基準として、上下左右の方向に何らかのデータが入力されている範囲
Dim rng as Range
set rng = Range("G1")
rng.CurrentRegion
'アクティブセル領域のアドレスを取得
rng.CurrentRegion.Address
'アクティブセル領域の1行目を選択する
rng.CurrentRegion.Rows(1).Select
'アクティブセル領域の3行目を選択する
rng.CurrentRegion.Rows(3).Select
'アクティブセル領域の基準行から2行オフセットした範囲を選択する
rng.CurrentRegion.Offset(2).Select
'アクティブセル領域の最終行目を選択する
With rng.CurrentRegion
.Rows(.rng.Rows.Count)Select
'アクティブセル領域の2行目から最終行目を選択する
With rng.CurrentRegion
.Rows("2:" & .Rows.Count).Select
End With
rg.CurrentRegion.Columns(2).Select
次のデータの入力位置
xlDirection列挙型を使用する Part 1
'セルB2を基準とし下方向の終端セルを取得し、その1つ下のセルを選択
Range("B2").End(xlDown).Offset(1).Select
xlDirection列挙型を使用する Part 2
上記の方法だと空白が間に挟まると空白行が最終として扱われてしまう。
基準とした列の最終行から上方向の終端セルを取得し、その1つ下が最終行とするアプローチもある
'B列全体の最終セルを取得し、そこから上方向への終端セルを取得して1つオフセットする
Range("B").Cells(Rows.Count).End(xlUp).Offset(1).Select
表全体の行数を数えてオフセットする
With Range("B2:F2")
.Offset(.CurrentRegion.Rows.Count).Select
End With
Findで検索した位置を元に取得する
数式が入っていて空白の場合、EndプロパティもCurrentRegionのCountプロパティも、連続したデータとして取り扱う。見かけで判断したいなら Find を使用する
Range("A2:F2").Find "*", After:=特定の先頭セル, _
LookIn:=xlValues, SearchDirection:=xlPrevious
テーブル
ListObject
Object/Collection | 用途 |
---|---|
ListObject Object | 個別のテーブル範囲を扱うオブジェクト |
ListObjects Collection | 個々のListObjectをまとめて扱うためのコレクションオブジェクト 各シートのListObjectsプロパティからアクセスする |
Sub ProcessRowsWithCreatedTrue()
Dim ws As Worksheet
Dim tbl As ListObject
Dim row As ListRow
' 対象のシートとテーブルを指定(シート名やテーブル名を適切に変更してください)
Set ws = ThisWorkbook.Sheets("Sheet1")
Set tbl = ws.ListObjects("Table1")
' "Created" 列のインデックスを取得
Dim createdColumnIndex As Long
createdColumnIndex = tbl.ListColumns("Created").Index
' 各行を処理
For Each row In tbl.ListRows
' "Created" 列が True の場合の処理
If row.Range(1, createdColumnIndex).Value = True Then
' ここに処理を記述
Debug.Print "行 " & row.Index & ": Created は True です"
End If
Next row
End Sub
行挿入
Call Range("B6").Insert(xlShiftDown)
没コード
Sub TemplateCopy()
Dim copyfrom As Range
Dim wb As Workbook
Dim ws As Worksheet
Set copyfrom = Range("[CatalogTemplateFactory.xlsm]CommonTemplate!_TEMPLATE_HOWTOAPPLY_")
Worksheets("t_W211").Copy
'Set ws = Workbooks("Book6").Worksheets("t_W211")
'テンプレート文字列の削除
Set torng = Range("B3")
torng.EntireRow.Delete
'コモンテンプレートから名前付け範囲をコピー&挿入
copyfrom.Copy
Call torng.Insert(xlShiftDown)
Application.CutCopyMode = False
'コピー元から行列調整
Dim myBaseRng As Range, myNewRng As Range
Dim myRow As Long, myClm As Long
Set myNewRng = Range("B3")
With copyfrom
For myClm = 1 To .Columns.Count
myNewRng.Columns(myClm).ColumnWidth _
= .Columns(myClm).ColumnWidth
Next
For myRow = 1 To .Rows.Count
myNewRng.Rows(myRow).RowHeight _
= .Rows(myRow).RowHeight
Next
End With
End Sub
Sub FindString()
Dim rng As Range
Dim firstAddress As String
Dim findstr As String
findstr = "_TEMPLATE_HOWTOAPPLY_"
Set rng = Cells.Find(findstr)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
'want do it
Debug.Print rng.Address
Set rng = Cells.FindNext(rng)
'First break
If firstAddress = rng.Address Then
Exit Do
End If
Loop While Not rng Is Nothing
End If
End Sub
Public Sub changeZoom()
Dim ws As Worksheet
' ブックの全シートを 1 つずつループして処理する
For Each ws In ThisWorkbook.Worksheets
Debug.Print ws.Name & "を処理します"
ws.Select
ActiveWindow.Zoom = 100
Next
End Sub
Sub MapSheet(funcName As String)
Dim ws As Worksheet
' ブックの全シートを 1 つずつループして処理する
For Each ws In ThisWorkbook.Worksheets
Debug.Print ws.Name & "を処理します"
Ret = Application.Run(funcName, ws)
Next
End Sub
Sub GetTemplateString()
'Debug.Print Cells(Rows.Count, 2).End(xlUp).Row
'Debug.Print Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp).Row)
'B列最終行までの範囲を取得
Dim rng As Range
Set rng = Range(Cells(1, 1), Cells(Cells(Rows.Count, 2).End(xlUp).row, 2))
Dim cell As Range
'"_" から始まるセルに対して操作
For i = rng.Rows.Count To 1 Step -1
With rng.Cells(i, 2)
If Left(.Value, 1) = "_" Then
Call CopyTemplateRange(.Value, rng.Cells(i, 2))
End If
End With
Next i
'For Each cell In rng
' If Left(cell.Value, 1) = "_" Then
' Debug.Print cell.Value, cell.Address
'
' Call CopyTemplateRange(cell.Value, cell)
' End If
'Next cell
End Sub
Sub SearchCommonTemplate()
End Sub
Sub OpenWorkbook()
Dim wb As Workbook
Set wb = Workbooks.Add
wb.Sheets(1).Cells(1, 1) = 20
wb.SaveAs "book2.xlsx"
wb.Close
End Sub
Sub OpenWorkbook2()
Dim wb As Workbook
Set wb = Workbooks.Add("book2.xlsx")
wb.Sheets(1).Cells(1, 1) = 20
wb.SaveAs "book3.xlsx"
wb.Close
End Sub
Sub Main()
Call OpenWorkbook2
End Sub