Excel VBA [セル範囲]

表形式

アクティブセル領域

特定セルを基準として、上下左右の方向に何らかのデータが入力されている範囲

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

返信を残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です