シート | Excel作業をVBAで効率化 https://vbabeginner.net いつものExcel作業はVBAを使えば数秒で終わるかもしれませんよ Sat, 09 Nov 2024 14:25:38 +0000 ja hourly 1 https://wordpress.org/?v=6.6.2 https://vbabeginner.net/wp-content/uploads/2019/02/favicon-150x150.png シート | Excel作業をVBAで効率化 https://vbabeginner.net 32 32 VBAでシートに空行を複数行追加する https://vbabeginner.net/add-multiple-blank-row/ Wed, 07 Jun 2023 15:29:20 +0000 https://vbabeginner.net/?p=6767 シートに空行を複数行追加するには

ここではシートに空行を複数行追加する方法について紹介します。

単純な空行の追加については「VBAでシートに空行を追加する」をご参照ください。

上のリンク先にも書いてありますが、シートに空行を追加するには、RangeオブジェクトのInsertメソッドを利用します。

複数行の追加の場合もそれは同じですが、Rangeオブジェクトの書き方が異なります。単一行か複数行かは、空行を追加する座標を示すRangeオブジェクトが1行か複数行のどちらを表しているかによって変わります。

また、シートに空行を追加する処理を書く場合、Rangeオブジェクトに複数行範囲を指定してまとめて空行を追加するのではなく、ループで空行を1行ずつ入れる方が都合がいい場合もあります。

そこで以下ではRangeオブジェクトで複数行を指定して空行を追加する方法と、ループ処理で空行を追加する方法の2つを紹介します。

1. Rangeオブジェクトで複数行を指定して空行を追加する方法

複数行を示すRangeオブジェクトの書き方にはRangeとRowsの2通りあります。

以下のコードは2行目から5行目(2,3,4,5行目の4行分)に空白を追加します。

Sub addMultiRowRange()
    Call Range("2:5").Insert
End Sub

Sub addMultiRowRow()
    Call Rows("2:5").Insert
End Sub

どちらを使っても結果は同じになります。

「Range(“2:5”)」も「Rows(“2:5”)」も、この書き方をしている時点で行範囲を指定していることになります。

そのため、RangeオブジェクトがRange(“A1”)などのように単一セルを指定しているときは、「Range(“A1”).EntireRow.Insert」と、単一セルを起点とした行全体を示す「EntireRow」プロパティを設定する必要がありますが、(“2:5”)のように2~5行目、と行全体であることが分かっている場合はEntireRowプロパティは不要になります。

なお、RangeとRowsはWorksheetsオブジェクトを親オブジェクトとして持つため、シートを指定する場合は以下のように書きます。

Sub addMultiRowRange2()
    Call Worksheets("Sheet1").Range("2:5").Insert
End Sub

Sub addMultiRowRow2()
    Call Worksheets("Sheet1").Rows("2:5").Insert
End Sub

2. ループで複数行の空行を追加する方法

以下は指定回数のループで空行を追加するコードです。上で紹介した「2~5行目に空行を追加する」コードと同じ動きになるように書いています。

コメントに大体書いてますが、やっているのは、基点となるセルを用意しておいて、あとはそこから指定回数だけ空行を1行ずつ追加する、という内容です。

Rangeオブジェクトを変数rに入れていますが、ここではA2セルを起点としており行全体を示しているわけではありません。そのため、空行を追加する箇所の処理では「Range.EntireRow.Insert」として、EntireRowプロパティを使って行全体を表すようにしています。

マクロ実行中に1行ずつ空行を追加することによるチラチラ防止のために「Application.ScreenUpdating = False/True」を入れてますが、空行追加には影響ないため、不要であれば削除してください。

Sub addMultiRowLoop()
    Dim i   As Integer      '// ループカウンタ
    Dim r   As Range        '// セル
    
    Application.ScreenUpdating = False
    
    '// 基点セルを指定
    Set r = Range("A2")
    
    i = 0
    Do
        '// ループカウンタが3を超えたらループ終了
        If i > 3 Then
            Exit Do
        End If
        
        '// 空行追加
        r.EntireRow.Insert
        
        '// ループカウンタ加算
        i = i + 1
    Loop
    
    Application.ScreenUpdating = True
End Sub

]]>
VBAでシートに空行を追加する https://vbabeginner.net/add-blank-row/ Tue, 06 Jun 2023 16:26:31 +0000 https://vbabeginner.net/?p=6764 シートに行を追加するには

シートに行を追加する場合、RangeオブジェクトのInsertメソッドを利用します。

なお、複数行追加する場合については「VBAでシートに空行を複数行追加する」もご参照ください。

VBAでは2通りの書き方があります。

どのセルの行に追加するか?」という書き方である、セルを示すRangeオブジェクトを使った場合の「Range.EntireRow.Insert」の書き方と、「どの行全体に行を追加するか?」という書き方である、行を示すRangeオブジェクトを使った場合の「Range.Insert」の書き方です。

行を示すRowsオブジェクトを使う「Rows(n).Insert」の書き方も「Range.Insert」の書き方の一種になります。

このようにRangeオブジェクトが何(セル? 行全体?)を示しているのかで、「EntireRow.Insert」と「Insert」のどちらを使うのかが変わります。

以下の3つの関数はいずれも6行目に空行を追加します。ただ、書き方が異なります。
‘// どれも同じ

Sub addrowtest1()
    '// A6セルを起点に行全体(EntireRow)に行を追加する
    Range("A6").EntireRow.Insert
End Sub

Sub addrowtest2()
    '// 6行目を下にシフトして空行を追加する(Rangeで6行目を指定)
    Call Range("6:6").Insert(Shift:=xlDown)
End Sub

Sub addrowtest3()
    '// 6行目を下にシフトして空行を追加する(Rowsで6行目を指定)
    Call Rows(6).Insert
End Sub

どれを使ってもいいです。

Rangeオブジェクトがセルを表している場合は「Range.EntireRow.Insert」で書き、行全体を表している場合は「Range.Insert」で書きます。

それぞれについて詳細を以下で説明していきます。

1. Range.EntireRow.Insertでの行追加の書き方

A1のようにセル座標を示すRangeオブジェクトを利用する場合は、「Range.EntireRow.Insert」の書き方になります。考え方は「このセルがある行に空行を追加する」という意味になります。EntireRowが「セルの行全体」を意味し、それ(セルがある行の行全体)に対してInsertメソッドで行を追加します。

Sub addrowtest1()
    '// A6セルを起点に行全体(EntireRow)に行を追加する
    Range("A6").EntireRow.Insert
End Sub

ここでは「Range(“A6”)」と書いていますが、以下のように「Cells(6, 1)」を使っても同じセルを意味するため、Range(“A6”)で書いたときと同じ動作になります。

Sub addrowtest11()
    '// A6セルを起点に行全体(EntireRow)に行を追加する
    Cells(6, 1).EntireRow.Insert
End Sub

2. Range.Insertでの行追加の書き方

行全体を示すRangeオブジェクトを利用する場合は、「Range.Insert」の書き方になります。RangeオブジェクトがEntireRowオブジェクトを使わなくても既に行全体を表しているためです。

具体的には「Range(“6:6”)」のように書いて6行目全体を表している場合か、行全体を表すRowsオブジェクトを使って「Rows(6)」のように書いている場合になります。ここではRangeでの書き方を説明します。

Sub addrowtest2()
    '// 6行目を下にシフトして空行を追加する(Rangeで6行目を指定)
    Call Range("6:6").Insert(Shift:=xlDown)
End Sub

Insertの引数にShiftがあります。これは元のデータをセルの下か右のどちらに移動するかを指定します。省略した場合はRangeオブジェクトのセル範囲に応じて元データの移動方向が決まります。そのため、Rangeオブジェクトで行全体を表していることが分かっている場合は省略しても下方向に移動すると自動でやってくれますので以下のようにInsertの引数の「(Shift:=xlDown)」を省略しても構いません。

Sub addrowtest2()
    '// 6行目を下にシフトして空行を追加する(Rangeで6行目を指定)
    Call Range("6:6").Insert
End Sub

なお、複数行に空行を追加したい場合は、以下のようにRangeの引数の数字を変えればOKです。

Sub addrowtest2()
    '// 6行目から8行目を下にシフトして空行を追加する
    Call Range("6:8").Insert(Shift:=xlDown)
End Sub

3. Rows.Insertでの行追加の書き方

行全体を表すRowsオブジェクトを使った場合は、Rowsオブジェクトが行全体を表しているためEntireRowオブジェクトを使わなくても構いません。でも使っても行全体を再選択されるだけなのでエラーにはなりません。通常は省略されます。

以下のコードはEntireRowがあるかないかの違いですが、どちらもエラーにならずに同じように6行目に空行を追加します。

Sub addrowtest3()
    '// 6行目を下にシフトして空行を追加する(Rowsで6行目を指定)
    Call Rows(6).Insert
End Sub

Sub addrowtest31()
    '// 6行目を下にシフトして空行を追加する(Rowsで6行目を指定)
    Call Rows("6:6").EntireRow.Insert
End Sub

なお、複数行に空行を追加したい場合は、以下のようにRowsの引数の数字を変えればOKです。

Sub addrowtest32()
    '// 6行目から8行目を下にシフトして空行を追加する
    Call Rows("6:8").Insert
End Sub

空行を追加すると元のデータはどこに行くのか

空行を追加することで、元々そこにあったデータは下の行に押し下げられます。

では、シートの最下段にデータがある場合に空行を追加するとどうなるかと言うと、エラーになります。

それ以上、下に移動できません、という意味です。

行を追加した場合、印刷範囲が変わりますので、もし厳密な印刷設定をしている場合は行追加後に想定通りに印刷が出来るかチェックした方がよいでしょう。

]]>
VBAで別シートのリストを入力規則として設定する https://vbabeginner.net/set-another-sheet-input-rule/ Tue, 28 Feb 2023 06:31:37 +0000 https://vbabeginner.net/?p=6627 入力規則を別シートで管理する

Excelのセルには事前に決められた値をプルダウンで選択できるようにする仕組みがあります。「データの入力規則」機能です。

設定されているセルにカーソルがあたると▼のプルダウン表示になります。

この設定をマクロで実施する方法を紹介します。

なお、Excel上での入力規則の操作方法ですが、Excelのデータタブ→データツール→「データの入力規則」を押すと、「データの入力規則」ダイアログが表示され、入力値の種類で「リスト」を選択して、元の値で別シートの列やセル範囲を選択することで設定できます。

「元の値」のセル範囲に左の絵の「$A:$A」のように書けばA列全体、右の絵の「$A$2:$A$5」のように書けばA2セルからA5セルの4セルが対象、という書き方になります。

ちなみに、プルダウンの元になるデータのシートですが、1行目は空にしておいて、2行目以降に選択肢を設定しておき、入力規則で「入力規則シート!$A:$A」のように列全体を指定すると、あとで選択肢が増えても設定を変更する必要がなくなりますのでお勧めです。欠点として、B列やC列に長いプルダウンの選択肢があると、A列のプルダウンも空白選択肢が増えてしまうという点があります。これが嫌な場合は「$A$2:$A$5」のようにセル範囲にしてください。

入力規則設定マクロ(単純バージョン)

以下のマクロは別シート(「入力規則」シート)に設定されている1種類の列を入力規則として設定するマクロです。

前提として、「入力規則」シートのA列に以下のようにデータが設定されているものとします。A列に、空、あり、なし、不明。

別のシートで入力規則を設定したいセル範囲を選択して以下のマクロを実行すると、「入力規則」シートのA列の内容がセルにプルダウンで選択できるようになります。

Sub SetInputRule()
    Dim sr  As Range        '// 選択セル範囲
    
    Set sr = Selection
    
    With sr.Validation
        '// 設定済みの入力規則を削除
        .Delete
        
        '// 入力規則を設定(「入力規則」シートのA列をプルダウン選択肢とする)
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=入力規則!$A:$A"
        
        '// セルへの空白入力をあり(True)
        .IgnoreBlank = True
        
        '// プルダウン表示あり(True)
        .InCellDropdown = True
    End With
End Sub

実行すると、こんな感じになります。

複数列の入力規則を設定するマクロ

上のマクロは単純に入力規則を設定するものですが、複数の入力規則データがある場合も紹介します。

前提として、「入力規則」シートのA、B列に以下のようにデータが設定されているものとします。

A列に、空、あり、なし、不明。
B列に、0以上~10未満、10以上~20未満、20以上~30未満、30以上~40未満、40以上~50未満、50以上。

それぞれを、アクティブシートのG列とH列に入力規則のプルダウンとして表示できるようにするマクロです。

関数が2つありますが、実行するのは1つ目のSetInputRule2関数で、そこからSetInputRuleFunction関数を呼び出しています。入力規則を設定したいシートをアクティブにして実行します。2つ目の関数には引数が2つあり、アクティブシートのどこにプルダウンを設定するのかを指定するセル範囲のRangeオブジェクトと、入力規則が設定されているシートのどの部分を入力規則として適用するのかをValidation.AddメソッドのFormula1プロパティに設定する文字列として指定します。

Sub SetInputRule2()
    Dim sht As Worksheet    '// アクティブシート
    Dim sr  As Range        '// 選択セル範囲
    
    Set sht = ActiveSheet
    
    '// アクティブシートのG列に、入力規則シートのA列で入力規則を設定する
    Set sr = sht.Range("G:G")
    Call SetInputRuleFunction(sr, "=入力規則!$A$1:$A$4")
    
    '// アクティブシートのH列に、入力規則シートのB列で入力規則を設定する
    Set sr = sht.Range("H:H")
    Call SetInputRuleFunction(sr, "=入力規則!$B$1:$B$7")
End Sub

'// 引数1:sr As Range      :入力規則を設定するセル範囲(プルダウンを設定する側)
'// 引数2:sRule As String  :入力規則の元データセル範囲
Sub SetInputRuleFunction(sr As Range, sRule As String)
    With sr.Validation
        '// 設定済みの入力規則を削除
        .Delete
        
        '// 入力規則を設定(「入力規則」シートのA列をプルダウン選択肢とする)
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=sRule
        
        '// セルへの空白入力をあり(True)
        .IgnoreBlank = True
        
        '// プルダウン表示あり(True)
        .InCellDropdown = True
    End With
End Sub

]]>
VBAで全シートの内容を1つにまとめる https://vbabeginner.net/combine-all-sheets/ Sun, 21 Nov 2021 14:49:56 +0000 https://vbabeginner.net/?p=6325 同じフォーマットのシートが複数あると集約が必要になる

事務作業でよくあるのが、同じフォーマットで複数のシートに入力する作業です。例えば、月ごとや日ごとの在庫管理シートや、売上管理の担当者シートなどです。

そしてそのようなブックを扱っていると後になって必要になるのが、複数シートの集約です。1年分にまとめたい、とか、全担当者分をまとめたい、とかですね。

このようなフォーマットは組織ごとに異なるため、集約方法にも当然のように違いがあるためそれら全てに対応することは出来ませんが、「全シートを1つにまとめたい」という目的は大体同じなので、ここではどのようなブックでも扱える「集約」に特化したコードを紹介します。

全シートの内容を新しいブックで1つにまとめる

以下のコードを実行すると、全シートの内容を新規ブックを作成して1つのシートに全て貼り付けます

関数が3つありますが、実行するのはMergeSheets()です。残りの2つはMergeSheets()から呼び出されるサブ関数です。

処理内容はコメントに大体書いていますが、考え方について補足します。

まず、まとめたいシートがあるブックを選択しておきます。そしてMergeSheets関数を実行すると、GetSheetData関数の中でコピー元の全シートをループして、各シートのセル入力範囲の内容をRangeオブジェクトとして取得します。取得はRangeオブジェクト配列(変数ar)に格納します。セル入力範囲の判定はUsedRangeを使っているため、シートごとにフォーマットが同じでも異なっていても、セル入力範囲は全てコピー対象になります。

その後、OutputData関数に全シートのデータ(配列ar)を渡して呼び出し、新規ブックを作成して、一番左のシートの上から順に全シートの内容が張り付けられます。

張り付ける順番は元のシートの左から順です。例えば、「1月」「2月」「3月」というシートが左から順にある場合は、新規ブックのシートには上から順に「1月」の内容、「2月」の内容、「3月」の内容が張り付けられます。

なお、コピーしたくないシートがある場合は、GetSheetData関数のsExcList変数にそのシート名を書いておけばコピーの対象にならないようにしています。そのようなコピーから除外したいシートが複数ある場合はコロン(:)でシート名を区切ってください。例えば、「1月」から「12月」までの12個のシートがある場合に、「4月」と「5月」と「12月」のシートをコピーしたくない場合は、「sExcList = “4月:5月:12月”」としてください。除外したいシートが1つだけの場合はコロンは不要です。

以下のコードでは元のシートの書式や値を全てコピーしていますが、値だけを張り付けたい場合はコメントアウトしている.Valueのコードを使えばそのようになります。

Sub MergeSheets()
    Dim ar()    As Range        '// シートのセル範囲配列
    
    ReDim ar(0)
    
    '// 全シートのデータを取得
    Call GetSheetData(ar)
    
    '// 取得した全シートのデータを新規ブックにまとめて出力する
    Call OutputData(ar)
End Sub

'// 全シートのセル範囲をシート毎に配列で取得
Sub GetSheetData(ar() As Range)
    Dim sExcList    As String       '// 除外するシート名リスト(複数時はコロン区切り:"aa:bb")
    Dim v           As Variant      '// 除外シート名の配列

    sExcList = "Sheet1:Sheet1 (3)"
'//    sExcList = ""
    
    '// 除外シートを配列化
    v = Split(sExcList, ":")
    
    Dim ws      As Worksheet    '// ワークシート
    
    '// 全シートをループ
    For Each ws In Worksheets
        Dim ex                          '// 除外シート
        
        '// 除外シートを全てループ
        For Each ex In v
            '// 除外対象のシートの場合は次のシートへ
            If ex = ws.Name Then
                GoTo CONTINUE
            End If
        Next
        
        '// シートの入力セル範囲のRangeオブジェクトを取得
        Set ar(UBound(ar)) = ws.UsedRange
        ReDim Preserve ar(UBound(ar) + 1)
        
CONTINUE:
    Next
    
    '// 配列が設定されていれば余分な空要素を削除する
    If IsEmpty(ar(0)) <> True Then
        ReDim Preserve ar(UBound(ar) - 1)
    End If
End Sub

'// セル範囲配列の内容を新規ブックに貼り付け
Sub OutputData(ar() As Range)
    Dim wb  As Workbook         '// 新規ブック
    Dim ws  As Worksheet        '// 新規ブックのシート
    
    '// 新規ブックを作成
    Set wb = Workbooks.Add
    '// 新規ブックのシートを参照
    Set ws = wb.Worksheets(1)
    
    Dim r   As Range            '// セル範囲
    Dim i   As Integer          '// インデックス
    
    '// セル範囲配列をループ
    For i = 0 To UBound(ar)
        Set r = ar(i)
        
        '// ループ初回
        If i = 0 Then
            '// 1行目に貼り付け
            '// 値だけをはりつける場合はこちら
            'ws.Range(r.Address).Value = r.Value
            
            '// セルの書式と値の両方を張り付け
            r.Copy
            Call ws.Range(r.Address).PasteSpecial(xlPasteAll)
        '// ループ2回目以降
        Else
            '// 入力済み行の1行下に貼り付け
            '// 値だけをはりつける場合はこちら
            'ws.UsedRange.Offset(ws.UsedRange.Rows.Count, 0).Range(r.Address).Value = r.Value
            
            '// セルの書式と値の両方を張り付け
            r.Copy
            Call ws.UsedRange.Offset(ws.UsedRange.Rows.Count, 0).Range(r.Address).PasteSpecial(xlPasteAll)
        End If
    Next
End Sub

使い方

使い方ですが、集約したいシートのブックを表示させて、GetSheetData関数を実行するだけです。実行すると、新規ブックの一番左のシートに集約されます。

なお、新規ブックの保存は行わないため、それは手で保存してください。保存処理を入れたい場合は「VBAでブックに名前を付けて保存する(SaveAs)」をご参照ください。

以下は使い方の例です。シートが5つあり、2つのシートをコピーから除外するようにしています。除外したいシートは上で書いている通りですが変数sExcListに記述しておきます。ここでは「sExcList = “Sheet1:Sheet1 (3)”」としています。

元の5つのシートが以下です。それぞれ行数が異なり、また、罫線やテーブルの種類も異なります。4つ目のシートは列数を変えています。

GetSheetData関数実行後に新規ブックに以下のように集約されます。元のシートの書式がそのままで反映されます。2つのシートが含まれていないのは変数sExcListで除外しているためです。

自動で保存はしていませんので手で保存してください。

]]>
VBAで一番左や一番右のシートにジャンプする https://vbabeginner.net/jump-to-leftmost-or-rightmost-sheet/ Mon, 06 May 2019 14:42:10 +0000 https://vbabeginner.net/?p=4314 シートが多いと他のシートの選択が面倒

Excelのブックにはシートをたくさん作ることが出来ます。作成可能なシート数の上限はメモリ量に依存するため明確な数はありませんが、以下のコードで試してみたら少なくとも私のPCでは2000までは作成できることを確認しました。

Sub SheetAddTest()
    Dim i       As Long         '// ループカウンタ
    
    i = 0
    Do
        If i > 2000 Then
            Exit Do
        End If
        
        '// シートを追加
        Call Sheets.Add(After:=Sheets(Sheets.Count))
        
        i = i + 1
        Debug.Print i
    Loop
End Sub

このような1000も2000もシートを持つブックはさすがに珍しいとは思いますが、それでも100近くのシートを持つブックは世の中に結構あると思います。実際私も見たことがあります。

そのようなシートが多いブックを使う場合に面倒なのがシートの選択です。シートが大量にあるようなブックの場合、「一覧」などの名前を付けたシートがあってそこから各シートの説明やハイパーリンクを貼っていることがありますが、そもそも「一覧」シートを選択するのにシートタブの左の部分を右クリックしてシートの選択ダイアログで選択する、という操作が面倒です。

一般的には「一覧」シートは一番左に置いてあることが多いと思います。そこで、一番左にぱっと移動するマクロを紹介します。

一番左のシートを選択するには

どのシートからも一番左のシートに移動するためには、一番左のシートをどうやって特定するのか、という点が重要になります。

その特定方法ですが、SheetsコレクションやWorksheetsコレクションの引数に1を設定するだけで特定が可能です。ワークシートだけしか使っていないのであればSheetsコレクションでもWorksheetsコレクションでもどちらも同じ結果になります。グラフシートやマクロシートやダイアログシートを使っている場合は違いがあり、これらのシートはSheetsコレクションにしか含まれません。

一般的にはワークシートだけを使うことの方が多いと思いますのでWorksheetsコレクションでの書き方を紹介します。

Sub SelectLeftMostSheet()
    Worksheets(1).Select
End Sub

1行で一番左のシートを選択可能です。

一番右のシートを選択するには

一番左のシートは「Worksheets(1)」と書けばよかったので簡単ですが、一番右のシートも大して変わりません。

Sub SelectRightMostSheet()
    Worksheets(Worksheets.Count).Select
End Sub

ワークシートの数は「Worksheets.Count」で取得できます。それをそのままWorksheetsコレクションのインデックスとして使えば一番右のシートを意味します。

使い方

上記マクロはすぐに使えることが条件になってきますので、クイックアクセスツールバーやリボンに登録しておくと便利です。

あとはコンテキストメニューに追加しておく方法もあります。

]]>
VBAでシートを任意の順番で並べ替える https://vbabeginner.net/sort-sheets-any-order/ Mon, 29 Apr 2019 18:23:57 +0000 https://vbabeginner.net/?p=4292 シートを任意の順に並べるには

ブックに複数のシートがあり並べ替えを行う場合、シートを一つずつ選択してドラッグしたり「シートの移動またはコピー」ダイアログを使って移動させることになります。ただ、シートの数が多い場合には面倒です。そこで自動で並べ替えを行う方法を紹介します。

ただ、シートの並べ替えを行うには事前にどの順序にするのかを決める必要があります。そのため、先に現状のシートの一覧を用意して、それからどのように並び替えを行うのかを決めていきます。シートの数が10個程度であればいいですが、50個も100個もあると現状のシートの一覧を作るだけでも一苦労です。

そこで、まず現状のシートの一覧を取得する方法と、それを任意の順に並べ替えたあとに、シートを並べなおす方法について説明します。

現状のシートの一覧の取得方法

以下のようにSheet1からSheet11まであるとします。そしてSheet12が隠しシートとして存在しています。

これらのシートの一覧を取得するコードは以下になります。シートの一覧は新しく追加シート(シート名は”AddSheet”)に出力されます。

Sub GetSheetList()
    Dim sht     As Object       '// シート
    Dim s       As String       '// 追加シート名
    Dim i       As Long         '// ループカウンタ
    
    '// シートを追加
    Call Sheets.Add(After:=Sheets(Sheets.Count))
    s = "AddSheet"
    ActiveSheet.Name = s
    Range("A1").Select
    
    '// ワークシートをループ
    For Each sht In Sheets
        '// 追加したシートではない場合
        If (sht.Name <> "AddSheet") Then
            '// シート名を追加シートのA列に貼り付け
            ActiveCell.Offset(i, 0).Value = sht.Name
        End If
        
        i = i + 1
    Next
End Sub

実行すると”AddSheet”シートに以下のように出力されます。

この”AddSheet”シートは次の処理で使うのでそのまま残しておいてください。あとで削除します。

コード内でSheetsコレクションを利用していますが、ワークシートしか使っていなのであればWorksheetsコレクションでも構いません。マクロシート、グラフシート、ダイアログシートを使っていることはほとんど無いと思います。

SheetsとWorksheetsの違いの詳細は「VBAのSheetsとWorksheetsの違い」をご参照ください。

「Sheets」と書いてある部分を全て「Worksheets」と書く場合は2行目の「Dim sht As Object」を「Dim sht As Worksheet」としてもOKです。

シートの並べ替え

上のマクロで”AddSheet”シートのA列にシートの一覧を出力しています。それを任意の順番に手で並べ替えます。ここでは以下のように並べ替えます。

並べ替え前 並べ替え後

“AddSheet”でのシート名の並べ替えが終わったあとに、実際のシートの並べ替えを行うコードは以下になります。

Sub ChangeOrder()
    Dim ar()    As String       '// シート名配列
    Dim i       As Integer      '// ループカウンタ
    Dim s       As String       '// セル値
    
    Sheets("AddSheet").Select
    Range("A1").Select
    
    i = 0
    ReDim ar(i)
    
    '// A列をループ
    Do
        '// セルの値を取得
        s = ActiveCell.Offset(i, 0).Value
        
        '// セルが未設定の場合
        If (s = "") Then
            '// ループを抜ける
            Exit Do
        End If
        
        '// 配列を拡張しセル値(シート名)を格納する
        ReDim Preserve ar(i)
        ar(i) = s
        
        i = i + 1
    Loop
    
    '// シートの順序を"AddSheet"の順に並べ替え
    i = 0
    Do
        '// 配列要素がない場合
        If (i > UBound(ar)) Then
            '// ループを抜ける
            Exit Do
        End If
        
        '// 配列の現ループ値のシート名を現ループカウンタ値の右に移動
        Sheets(ar(i)).Move before:=Sheets(i + 1)
        
        i = i + 1
    Loop
    
    '// シート削除の確認ダイアログを表示させてないように指定
    Application.DisplayAlerts = False
    
    '// "AddSheet"シートを削除
    Sheets("AddSheet").Delete
    
    Application.DisplayAlerts = True
End Sub

コードが長いですが、やっていることは大したことがなく、”AddSheet”のA1セルから下に向かってセルの値をシート名として取得し、それを配列に格納します。そしてその配列に格納されたシート名を先頭から順にSheets.Moveメソッドで一番左から順に移動して並べ替えを行っています。配列の設定とシートの並び替えは同時に行うことが出来てコードも短くできますが、あえて分かりやすいように分けて書いています。

最後に上のマクロで追加した”AddSheet”シートを削除しています。シートのDeleteメソッドはシート削除してよいかどうかを確認するダイアログが表示されるため、それを非表示にするためにDisplayAlertsプロパティでFalseにして、Deleteメソッド後に元のTrueに戻しています。

シートの削除(Deleteメソッド)の詳細は「VBAでシートの削除を行う」をご参照ください。

実行後

シートの並べ替えのChangeOrder関数を実行すると以下のようにシートの順番が”AddSheet”に書いた順番になり、”AddSheet”が削除されます。

]]>
VBAで複数の名前付きシートを一度に追加する https://vbabeginner.net/add-multiple-named-sheets/ Mon, 01 Apr 2019 16:08:17 +0000 https://vbabeginner.net/?p=4196 シートを一度に複数追加するには

シートの追加を複数行うには、Sheets.AddメソッドかWorksheets.Addメソッドを必要な回数繰り返すことになります。

なお、シートの追加についての詳細は「VBAでシートの追加を行う」をご参照ください。

ただ追加するだけであれば引数無しのWorksheets.Addメソッドを何度も実行すればいいのですが、シート見出しの一番左にSheet2、Sheet3と連番で追加されるだけなので、シート名を付けたい場合はNameプロパティを設定する必要があります。

以下で紹介するコードは、カンマ区切りのシート名を文字列として引数に渡されると、そのシート名で追加する処理になります。

コード

引数で渡された”aa,bb,cc”のようなカンマで区切られた文字列を元に新規シートを追加するコードです。

前提として、新規するシートはアクティブウィンドウの一番右のシートになります。複数のシートを追加する場合は一番右に追加されていきます。

このコードはわかりやすさを優先するため、あえてエラー処理は入れていません。そのため、引数文字列が不正の場合は異常終了することもあり得ます。

引数文字列が既存シート名と重複しないことを確認してください。引数の文字列のフォーマットは”aa,bb,cc”のように追加するシート名をカンマで区切ります。

Sub MultiSheetsAdd(sSheets As String)
    Dim iSheetCount         '// アクティブブックのシート数
    Dim i                   '// ループカウンタ
    Dim sht As Worksheet    '// 追加するワークシートオブジェクト
    Dim v                   '// 引数文字列をカンマで分割した文字列配列
    
    '// 引数文字列をカンマで分割し、その結果を配列で取得
    v = Split(sSheets, ",")
    
    '// アクティブブックのシート数を取得
    iSheetCount = ActiveWorkbook.Sheets.Count
    
    '// 一番右のシートを選択
    Sheets(iSheetCount).Select
    
    '// カンマ区切りの数だけループ
    For i = 0 To UBound(v)
        '// アクティブシートの右に新規シートを追加
        Set sht = Sheets.Add(After:=ActiveSheet)
        
        '// シート名を設定
        sht.Name = v(i)
    Next
End Sub

 

上の関数を呼び出すコードです。引数に追加するシート名をカンマ区切りで指定します。

Sub MultiSheetsAddTest()
    Call MultiSheetsAdd("1,2,3,10,11,13")
End Sub

実行すると、1、2、3、10、11、13のシートが作成されます。

]]>
VBAでシート全体の行数や列数を取得 https://vbabeginner.net/get-last-row-column/ Wed, 30 Jan 2019 19:11:11 +0000 https://vbabeginner.net/?p=3889 ワークシート全体の行数と列数

VBAでシート全体の行数や列数を取得したいことがあります。

コードでは以下のようにRows.CountとColumns.Countの1行でそれぞれ取得できます。

Sub GetRowColumnCount()
    Dim iMaxRow
    Dim iMaxColumn
    
    '// シートの行数を取得
    iMaxRow = Rows.Count
    '// シートの列数を取得
    iMaxColumn = Columns.Count
    
    Debug.Print "シート全体の行数=" & iMaxRow
    Debug.Print "シート全体の列数=" & iMaxColumn
End Sub

RowsとColumnsはWorksheetオブジェクトの子になります。

そのため、一番左のシートを対象としたい場合には、Rows.とColumns.の左にWorksheets(1).と加えて書いても同じ意味になります。

Worksheets(1).Rows.Count
Worksheets(1).Columns.Count

親のシートオブジェクトを省略した場合はアクティブシートが対象になります。

もちろんアクティブシートであることを明示して以下のように書いても構いません。

ActiveSheet.Rows.Count
ActiveSheet.Columns.Count

 

取得は事前に1回だけにする

ワークシートの行数と列数はOfficeのバージョンで決まっています。

Office2003までは行数は65536、列数は256、Office2007からは行数は1048576、列数は16384です。

この値は変わらないため、VBA処理の初期処理として1度だけ取得して変数に入れておき、あとはその全体行数と全体列数の変数を必要なときに使うようにすれば、少しではありますが処理速度の向上につながります。

行数の取得を1回で済むようにする

例えば、シートの一番下の行に到達したかどうかの判定などをしたい場合は以下のような感じのコードにします。

Sub LoopMaxRow()
    Dim iMaxRow             '// シート全体の行数
    Dim iNowColumn          '// 現在列位置
    Dim i                   '// ループカウンタ
    Dim r       As Range    '// 処理中セル
    
    '// シートの行数を取得
    iMaxRow = ActiveSheet.Rows.Count
    
    '// 現在列位置を取得
    iNowColumn = ActiveCell.Column
    
    '// 現在セルの行位置を取得
    i = ActiveCell.Row
    
    '// ループ
    Do
        '// 最終行に到達した場合
        If (i > iMaxRow) Then
            '// ループを抜ける
            Exit Do
        End If
        
        '// 現在ループ位置のセルのRangeオブジェクトを取得
        Set r = Cells(i, iNowColumn)
        
        '// 次行用に加算
        i = i + 1
    Loop
End Sub

 

列数の取得を1回で済むようにする

終端行ではなく終端列かどうかの判定をしたい場合は、Rows.Countの個所とループカウンタを列単位にすると上と同じように終端列への到達の判定が可能です。

Sub LoopMaxColumn()
    Dim iMaxColumn          '// 終端列
    Dim iNowRow             '// 現在行位置
    Dim i                   '// ループカウンタ
    Dim r       As Range    '// 処理中セル
    
    '// シートの列数を取得
    iMaxColumn = Columns.Count
    
    '// 現在行位置を取得
    iNowRow = ActiveCell.Row
    
    '// 現在セルの列位置を取得
    i = ActiveCell.Column
    
    '// ループ
    Do
        '// 終端列に到達した場合
        If (i > iMaxColumn) Then
            '// ループを抜ける
            Exit Do
        End If
        
        '// 現在ループ位置のセルのRangeオブジェクトを取得
        Set r = Cells(iNowRow, i)
        
        '// 次列用に加算
        i = i + 1
    Loop
End Sub

]]>
VBAでシートのインデックスを取得する https://vbabeginner.net/get-sheet-index/ Sat, 24 Nov 2018 17:09:25 +0000 https://vbabeginner.net/?p=3718 SheetsオブジェクトのIndexプロパティ

ブックにあるシートのインデックスは、SheetsオブジェクトやWorksheetsオブジェクトのIndexプロパティで取得できます。

Sheetsオブジェクトはワークシートだけでなくグラフシート、マクロシート、ダイアログシートも含みますが、Worksheetsオブジェクトはワークシートのみを対象とします。

SheetsオブジェクトとWorksheetsオブジェクトの違いについては「VBAのSheetsとWorksheetsの違い」をご参照ください。

なお、シート数はCountプロパティで取得できます。

Indexプロパティは1から始まるため、一番右のシートのインデックスはCountプロパティと同じ値になります。

ブックとシートは違います

ブックとシートの違いを聞かれることがあります。

ブックは「test.xlsx」などのファイル自体を指します。

シートはブックを開いた時に下段に表示されて、それぞれ別の用紙のように扱われ、シートごとに名前が付けられます。

ブックのインデックス、という言い方はそもそもあまりしませんが、シートのインデックスというと、通常は左から2番目のシートのインデックスは2、という意味で使われます。

上の画像で言えば、Sheet1がインデックス1、Sheet2がインデックス2、Sheet3がインデックス3になります。

さらに右にシートが1つ追加されれば、追加したシートのインデックスは4になります。

全てのインデックスを取得するサンプルコード

以下のコードはワークシート全てのインデックスを取得するサンプルです。

ループして、1シートずつインデックスとシート名を表示します。

ここではWorksheetsだけしかない場合のコードとシートの種類が複数ある場合のそれぞれについてサンプルを紹介します。

ワークシートだけの場合(Worksheetsオブジェクト)

ワークシートだけのインデックスが取得できればいい場合は、以下のようにWorksheetsオブジェクトのループを行います。

Sub SheetIndexTest()
    Dim sht As Worksheet
    
    For Each sht In Worksheets
        Debug.Print "Index=" & sht.Index & " Name=" & sht.Name
    Next
End Sub

実行結果
Sheet1、Sheet2、Sheet3の3つのシートがある場合に実行すると以下が出力されます。

Index=1 Name=Sheet1
Index=2 Name=Sheet2
Index=3 Name=Sheet3

全ての種類のシートの場合(Sheetsオブジェクト)

マクロシートなどがある場合はWorksheetsオブジェクトではなくSheetsオブジェクトのループを行います。

また、2行目のsht変数もワークシート以外のマクロシートなども対象とするために、型はObject型にします。

Sub SheetIndexTest2()
    Dim sht As Object
    
    For Each sht In Sheets
        Debug.Print "Index=" & sht.Index & " Name=" & sht.Name
    Next
End Sub

実行結果
Sheet1、Sheet2、Sheet3、Macro1(マクロシート)の4つのシートがある場合に実行すると以下が出力されます。

Index=1 Name=Sheet1
Index=2 Name=Sheet2
Index=3 Name=Sheet3
Index=4 Name=Macro1

なお、この4シートがあるブックで、先のワークシートのみを対象とするSheetIndexTest()を実行すると、マクロシートのインデックス4はワークシートではないため出力されません。

アクティブシートのインデックス番号を取得するには

現在表示されているアクティブシートのインデックスを取得する場合は、アクティブシートを示すActiveSheetオブジェクトのIndexプロパティを取得します。

Sub ActivesheetIndexTest()
    Dim i
    
    i = ActiveSheet.Index
    
    Debug.Print i
End Sub

なお、ActiveSheetオブジェクトはドット(.)を押してもプロパティ候補が出ません。

もし出したい場合は以下のようにWorksheetオブジェクトに変換すると表示されるようになります。

Sub ActivesheetIndexTest2()
    Dim i
    Dim sht As Worksheet
    
    Set sht = ActiveSheet
    i = sht.Index
    
    Debug.Print i
End Sub

]]>
右端シートから左端、左端シートから右端へ移動する https://vbabeginner.net/move-from-edge-sheet/ Thu, 04 Oct 2018 17:27:54 +0000 https://vbabeginner.net/?p=3613 シートの右端から左端へ、左端から右端へ移動

シートの移動にショートカットを利用されている方がおられると思います。

右のシートに移動する場合はCtrl + PageDown、左のシートに移動する場合はCtrl + PageUpです。

私もこのショートカットをマウスホイールの左右の動きに割り当てていたのですが、しばらく使っていると不便を感じてきました。

それは、左端や右端のシートに到達した場合、反対側のシートに移動してくれないことです。

そのように両端に到達した場合に、反対側のシートの端に移動するのが以下の関数になります。

マクロの紹介

以下に3つの関数がありますが、実際に使うのは1つ目「シート右移動」と2つ目の「シート左移動」です。

3つ目の「シート選択」は1つ目と2つ目から呼び出される関数です。

「シート右移動」は右のシートに移動し、一番右のシートの場合は一番左のシートに移動します。

「シート左移動」はその逆です。

非表示シートが存在する場合は読み飛ばして、表示シート間の移動を行うようにしています。

'//----------------------------------------------------------------------------
'// 機能   :シート右移動
'// 引数   :なし
'// 戻り値  :なし
'//----------------------------------------------------------------------------
Sub シート右移動()
    Dim iSheetCount
    Dim iNowIndex
    Dim shActive
    
    iSheetCount = Sheets.Count
    Set shActive = ActiveSheet
    iNowIndex = shActive.Index
    
    If (iSheetCount > 1) Then
        '// 一番右のシートの場合
        If (iSheetCount = iNowIndex) Then
            '// 一番左のシートを選択
            Call シート選択(1, "Right")
        Else
            Call シート選択(iNowIndex + 1, "Right")
        End If
    End If
    
End Sub

'//----------------------------------------------------------------------------
'// 機能   :シート左移動
'// 引数   :なし
'// 戻り値  :なし
'//----------------------------------------------------------------------------
Sub シート左移動()
    Dim iSheetCount
    Dim iNowIndex
    Dim shActive
    
    iSheetCount = Sheets.Count
    Set shActive = ActiveSheet
    iNowIndex = shActive.Index
    
    If (iSheetCount > 1) Then
        '// 一番左のシートの場合
        If (1 = iNowIndex) Then
            '// 一番右のシートを選択
            Call シート選択(iSheetCount, "Left")
        Else
            Call シート選択(iNowIndex - 1, "Left")
        End If
    End If
    
End Sub

'//----------------------------------------------------------------------------
'// 機能   :シート選択
'// 引数   :(I)   a_iSheetNo          :遷移先シートのindex
'//         :(I)   a_sLeftRight        :左右のどちらに遷移するかを指定する("Left","Right")
'// 戻り値  :なし
'// 備考   :非表示シートは飛ばして次の表示シートを選択する
'//----------------------------------------------------------------------------
Sub シート選択(a_iSheetNo, a_sLeftRight)
    Dim iSheetCount
    Dim sht
    Dim iAdd
    Dim iMark
    Dim iSheetNo
    
    iSheetCount = Sheets.Count
    iSheetNo = a_iSheetNo
    
    If (a_sLeftRight = "Left") Then
        iMark = -1
    Else
        iMark = 1
    End If
    
    iAdd = 0
    
    '// 全シートが非表示なのはありえないため、例外系の終了条件は設けない(表示シートにあたるまでループする)
    Do
        Set sht = Sheets(iSheetNo + iAdd)
        
        '// シートが表示されている場合
        If (sht.Visible <> xlSheetHidden) And (sht.Visible <> xlSheetVeryHidden) Then
            sht.Select
            Exit Do
        End If
        
        iAdd = iAdd + iMark
        
        '// 右端を越えた場合は一番左に遷移
        If (iSheetCount < iSheetNo + iAdd) Then
            iSheetNo = 1
            iAdd = 0
        '// 左端を越えた場合は一番右に遷移
        ElseIf (iSheetNo + iAdd = 0) Then
            iSheetNo = iSheetCount
            iAdd = 0
        End If
    Loop
End Sub

 

便利な使い方

もし利用しているマウスがショートカットキー割り当て機能があれば、上記関数を割り当てることでマウスだけでシート移動が可能になります。

私自身はLogicoolのマウスを使っており、「シート左移動」にCtrl + Shift + H(Hidari@左)を割り当て、「シート右移動」にCtrl + Shift + M(Migi@右)を割り当てて、それぞれをマウスホイールの左右の動作設定にしています。

マウスホイールを左右に動かすだけでシート移動ができるので、とてもラクで重宝しています。

]]>