04-02_sheet

タイトル欄のアドレスは、エクセルファンクラブの該当する頁へのリンク先です。
詳しい事は、こちらのお願いをご覧になってください。

シートの順番を入れ替えても、左から順番にシート名に連番を振るには？

イベント・マクロでシートに連番を振ります。
ただし、一枚のシートの位置を変えたときには、そのあとで他のシートを
選んでやる必要があります。
　Private Sub Workbook_SheetActivate(ByVal Sh As Object)
　　Dim n As Integer
　　Application.ScreenUpdating = False
　　n = 1
　　For Each Sh In ThisWorkbook.Worksheets
　　　Sh.Name = "K" & n 　　' 一旦、仮のシート名をつけます
　　　n = n + 1
　　Next
　　n = 1
　　For Each Sh In ThisWorkbook.Worksheets
　　　Sh.Name = "R" & n　　 ' あらためて本当のシート名にします
　　　n = n + 1
　　Next
　　Application.ScreenUpdating = True
　End Sub
　　このコードの使い方は、マクロの使い方(３)This Workbookのモジュールにあります。

このコードでは、R1、R2、R3というシート名になっていますが、
１ページ、２ページ、３ページ、にする場合
　Sh.Name = "R" & n　　 ' あらためて本当のシート名にします
のところを、
　Sh.Name = StrConv(n,4) & "ページ"
にします。

シートの順番を入れ替えても、左のシートから順番にページ番号を振るには？
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200202/02020041.txt
　　「複数のシートに左側からオートでページ番号をつけたい（入れ替えた時も）」【編集ラウンジ】

1.　【ファイル】【ページ設定】【ヘッダーフッター】で、【ヘッダーの編集】（または、フッターの編集）で、
　　あらかじめページ番号を表示するように設定しておきます。
2.　【ファイル】【印刷】で、【印刷対象】欄の【ブック全体】にチェックを入れます。

リストからシートを選択し、シート名を取得するには？
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200202/02020246.txt
　　「シート名の取得」　【VBAラウンジ】

Sub select_sheet()
　Dim sheet_name As Variant
　MsgBox "シートを選択してください。"
　Do
　 CommandBars("Workbook tabs").ShowPopup
　 sheet_name = Application.InputBox("このシートで良いですか？", , ActiveSheet.Name)
　Loop Until sheet_name <> False
　MsgBox sheet_name
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

アクティブなシートの右のシートを選択するには

Sub test()
　On Error Resume Next
　Sheets(ActiveSheet.Index + 1).Select
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

ファイル内のすべてのシートを、一枚ずつ新規のブックにコピーしてシート名で保存するには

Sub miko_test()
　Dim i As Integer, j As Integer, n As String, nn As String
　Application.ScreenUpdating = False
　i = Sheets.Count　　　　　　　　　　 'シート枚数のカウント
　n = ActiveWorkbook.Name 　　　　'コピー元ファイルの名前を取得
　For j = 1 To i 　　　　　　　　　　　　'一番左のシートから最後のシートまで繰り返す
　　Sheets(j).Copy 　　　　　　　　　　'シートを新規ブックにコピー
　　nn = ActiveSheet.Name　　　　　 'シートの名前を取得
　　'新規ブックを、シートの名前でC:\My Documentsの中に保存して閉じる
　　With ActiveWorkbook
　　　.SaveAs "C:\My Documents\" & nn
　　　.Close
　　End With
　Next
　Application.ScreenUpdating = True
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

シートを左から（右から）数えて指定するには？
http://cgi.fuji.ne.jp/~fj2094/cgi-bin2/wwwlng.cgi?print+200202/02020252.txt
　　「シートの参照で」　【関数ラウンジ】

Function store(ByVal shno As Integer, ByVal cead As Range)
　Application.Volatile
　store = Worksheets(shno).Range(cead.Address).Value
End Function
　　このコードの使い方は、ユーザー定義関数（標準モジュール）の使い方にあります。
上記のコードを書き込み、セルに直接赤字部分を記入します。
=store(1,B1) 　　 '左から１枚目のシートのＢ１を引っ張って来ます。
=store(F1,A2)　　'左からF1の示す番目のシートのＡ１を引っ張って来ます（F1が３なら３枚目）

Sub test()
　'アクティブシートの１行１列目（A1）のセルに左から２番目のシートのA1セルの値を入力
　Cells(1, 1) = Worksheets(2).Range("A1")
　'アクティブシートの２行１列目（A2）のセルに左から６番目のシートのA1セルの値を入力
　Cells(2, 1) = Worksheets(6).Range("A1")
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

Sub test()
　Dim Sh_leftNo As Integer, Sh_RightNo As Integer, Wb_Sh As Integer
　Wb_Sh = ThisWorkbook.Worksheets.Count 　　　'このファイルのシート数
　Sh_leftNo = ActiveSheet.Index 　　　　　　　　　　'アクティブシートの左からの順番
　Sh_RightNo = ThisWorkbook.Worksheets.Count - ActiveSheet.Index + 1
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'アクティブシートの右からの順番
　MsgBox "このファイルのシート数は　" & Wb_Sh & "　枚です"
　MsgBox "このシートは左から　" & Sh_leftNo & "　番目のシートです"
　MsgBox "このシートは右から　" & Sh_RightNo & "　番目のシートです"
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　Dim Sh_leftNo As Integer, Sh_RightNo As Integer, Wb_Sh As Integer
　Cancel = True
　Wb_Sh = ThisWorkbook.Worksheets.Count　　　　　　　　　 'このファイルのシート数
　Sh_leftNo = Target.Worksheet.Index　　　　　　　　　　　　　 'このシートの左からの順番
　Sh_RightNo = ThisWorkbook.Worksheets.Count - Target.Worksheet.Index + 1
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'このシートの右からの順番
　MsgBox "このファイルのシート数は　" & Wb_Sh & "　枚です"
　MsgBox "このシートは左から　" & Sh_leftNo & "　番目のシートです"
　MsgBox "このシートは右から　" & Sh_RightNo & "　番目のシートです"
End Sub
　　このコードの使い方は、マクロの使い方(２)該当するシートのモジュールにあります。

シートをシート名で昇順（降順）に並び替えるには？

シートを昇順、または降順で並び替えるにはマクロを使いますが、
シートの場合、形式が混在するとうまく並び替えることができません。
セルを昇順に並べ替えた場合と、シートをマクロで並べ替えた場合では、このように違ってきます。

セル		シート
1	半角	1	半角
2	半角	2	半角
１	全角	BB	半角
２	全角	aa	半角
aa	半角	ああ	全角
ａａ	全角	いい	全角
BB	半角	一番	全角
ＢＢ	全角	二番	全角
ああ	全角	１	全角
ｱｱ	半角	２	全角
いい	全角	ＢＢ	全角
ｲｲ	半角	ａａ	全角
一番	全角	ｱｱ	半角
二番	全角	ｲｲ	半角

Sub miko_test()　　　’昇順、または降順を指定して並べ替えます
　Dim i As Integer, j As Integer
　If MsgBox("シートを昇順に並べ替えますか？降順の場合は「いいえ」を選んでください", _
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　vbYesNo + vbQuestion) = vbYes Then
　　For i = 1 To ActiveWorkbook.Sheets.Count
　　　For j = 1 To ActiveWorkbook.Sheets.Count - i
　　　　If Sheets(i).Name > Sheets(i + j).Name Then
　　　　　Sheets(i + j).Move before:=Sheets(i)
　　　　End If
　　　Next
　　Next
　ElseIf vbNo Then
　　For i = 1 To ActiveWorkbook.Sheets.Count
　　　For j = 1 To ActiveWorkbook.Sheets.Count - i
　　　　If Sheets(i).Name < Sheets(i + j).Name Then
　　　　　Sheets(i + j).Move before:=Sheets(i)
　　　　End If
　　　Next
　　Next
　End If
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

フォルダ内の全てのcsvファイルを読み込んで、シート内に書き出すには？

C:\My Documents\testフォルダ内の全てのcsvファイルを、順番に開いてsheet1に書き出します。
書き出し後は、csvファイルを閉じて終わります。
Sub miko_test()
　Dim BookName As String, PathName As String
　Dim WS1 As Worksheet, WS2 As Worksheet
　Dim i As Long, j As Integer
　Application.DisplayAlerts = False　　　　　　　　　　　 '警告を非表示
　Set WS1 = Worksheets("sheet1")　　　　　　　　　　 '書き出すシート
　PathName = "C:\My Documents\test\"　　　　　　 'ファイルの入っているフォルダを指定
　BookName = Dir(PathName & "*.csv") 　　　　　　　'処理するファイルはcsvのファイル（拡張子csv）
　Do Until BookName = ""
　　Workbooks.Open PathName & BookName 　　　　　'ファイルを開く
　　Set WS2 = Worksheets(1) 　　　　　　　　　　　　　　'読み込むシート
　　WS2.Rows("1:" & WS2.UsedRange.Rows.Count).Copy
　　If WS1.UsedRange.Rows.Count = 1 Then
　　 WS1.Rows(WS1.UsedRange.Rows.Count).PasteSpecial Paste:=xlValues
　　Else
　　 WS1.Rows(WS1.UsedRange.Rows.Count + 1).PasteSpecial Paste:=xlValues
　　End If
　　Workbooks(BookName).Close　　　　　　　　　　　　 'ファイルを閉じる
　　BookName = Dir() 　　　　　　　　　　　　　　　　　　　'ファイル名をクリア
　Loop
　Range("A1").Select
　Application.DisplayAlerts = True 　　　　　　　　　　　　'警告を表示
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

新規のファイルに１か月分の日付のシートを一気に作成するには？

Sub miko_test()
　Dim BN As String, i As Integer, SN As String
　Application.DisplayAlerts = False 　　　'警告を非表示
　Application.ScreenUpdating = False 　'画面の動きを固定
　BN = Application.InputBox("作成する年月を入力してください", , Default:="2002.7", Type:=2)
　Workbooks.Add '新規ファイルを作成
　'指定月に該当する最終日を設定
　Select Case Right(BN, Len(BN) - 5)
　　Case 2
　　　'うるう年の判定
　　　If (Left(BN, 4) - 2000) Mod 4 = 0 Then
　　　　SN = 29
　　　Else
　　　　SN = 28
　　　End If
　　Case 4, 6, 9, 11
　　　SN = 30
　　Case 1, 3, 5, 7, 8, 10, 12
　　　SN = 31
　End Select
　'既存のシートのシート名入力
　For i = 1 To Sheets.Count
　　Sheets(i).Name = Right(BN, Len(BN) - 5) & "." & i
　Next
　'不足分のシートを挿入してシート名、A1セルを入力
　For i = Sheets.Count + 1 To SN
　　Sheets.Add After:=Worksheets(Worksheets.Count)
　　Sheets(i).Name = Right(BN, Len(BN) - 5) & "." & i
　Next
　Application.ScreenUpdating = True 　'画面の固定を解除
　Application.DisplayAlerts = True 　　　'警告を表示
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

１か月分のシート(28～31シート)１年分(12ブック)を一気に作成するには？
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi?print+200207/02070022.txt　
　「1年分の日報をまとめてつくりたいのですが」　【編集ラウンジ】

Sub miko_test()
　Dim BN As String, i As Integer, j As Integer, SN As String
　Application.DisplayAlerts = False 　　　　　'警告を非表示
　Application.ScreenUpdating = False 　　　'画面の動きを固定
　BN = Application.InputBox("作成する年度を入力してください", , Default:="2002", Type:=2)
　For j = 1 To 12
　　'新規ファイルを作成
　　Workbooks.Add
　　'指定月に該当する最終日を設定
　　SN = Day(DateSerial(BN, j + 1, 0))
　　'既存のシートのシート名、A1セルを入力
　　For i = 1 To Sheets.Count
　　　Sheets(i).Name = j & "." & i
　　　With Sheets(i).Range("A1")
　　　　.Value = BN & "/" & j & "/" & i
　　　　.NumberFormatLocal = "yyyy.m.d (aaa)"
　　　End With
　　Next
　　'不足分のシートを挿入してシート名、A1セルを入力
　　For i = Sheets.Count + 1 To SN
　　　Sheets.Add After:=Worksheets(Worksheets.Count)
　　　Sheets(i).Name = j & "." & i
　　　With Range("A1")
　　　　.Value = BN & "/" & j & "/" & i
　　　　.NumberFormatLocal = "yyyy.m.d (aaa)"
　　　End With
　　Next
　　'My Documentsに名前を付けて保存
　　ActiveWorkbook.SaveAs "C:\My Documents\" & BN & "年" & j & "月"
　　ActiveWorkbook.Close
　Next
　Application.ScreenUpdating = True　　　 '画面の固定を解除
　Application.DisplayAlerts = True　　　　　 '警告を表示
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

ワークシートのオブジェクト名を取得するには？
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200206/02060467.txt　
　「シートのオブジェクト名を取得するには。。。」　【VBAラウンジ】
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200208/02080181.txt　
「シートのオブジェクト名を取得するには？」　【VBAラウンジ】

Sub Test()
　Dim c As Worksheet
　For Each c In Worksheets
　　Debug.Print c.CodeName
　Next
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

Sub Test()
　MsgBox ActiveSheet.CodeName
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

ワークシートのオブジェクト名を変更するには？
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200111/01110008.txt　
　「シートのオブジェクト名を変更するには？」　【VBAラウンジ】
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200105/01050128.txt　
　「シートのオブジェクト名を変更するには？」　【VBAラウンジ】

シートのオブジェクト名を変更するときは、隠しプロパティである「_CodeName」というものを使わないと、ファイルの破損の原因になるそうです。
Sub Test()
　Dim strOldName As String
　Dim strNewName As String
　'古いオブジェクト名
　strOldName = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).CodeName
　'新しいオブジェクト名
　strNewName = "NewName"
　'オブジェクト名変更
　ThisWorkbook.VBProject.VBComponents(strOldName).Properties("_CodeName") = strNewName
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。

数の定まっていない全てのシートを選択するには？

Sub test()
　Dim WSN() As String 　　　　　　　　　　　　'シート名
　Dim i As Integer, j As Integer
　i = Worksheets.Count 　　　　　　　　　　　　'シート数をカウント
　ReDim WSN(1 To i) 　　　　　　　　　　　　　'シート名の変数の数を設定
　For j = 1 To i
　　WSN(j) = Sheets(j).Name　　　　　　　　　 'シート名を変数に格納
　Next
　Sheets(WSN).Select　　　　　　　　　　　　 '全シートを選択
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。　

セルに入力した日付順にシートを並べ替えるには？
http://www.ae.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200307/03070293.txt
　「シートの並びかえ」　【VBAラウンジ】

'全シートのA1セルに日付を入れた状態で、日付の新しいシートを左に、古いシートを右に移動します。
Sub Test()
　Dim Sh As Worksheet
　Dim i As Integer
　Dim Snm1 As String, Snm2 As String
　Set Sh = Worksheets(1)
　Application.ScreenUpdating = False
　For i = 1 To Worksheets.Count
　　With Worksheets(i)
　　　Sh.Cells(i, 26).Value = .Cells(1).Value
　　　Sh.Cells(i, 27).Value = .Name
　　End With
　Next i
　Sh.Cells(1, 26).CurrentRegion.Sort Key1:=Sh.Columns(26), _
　Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortColumns
　For i = 2 To Sh.Cells(65536, 27).End(xlUp).Row
　　Snm1 = Sh.Cells(i - 1, 27).Value
　　Snm2 = Sh.Cells(i, 27).Value
　　Worksheets(Snm2).Move After:=Worksheets(Snm1)
　Next i
　Sh.Cells(1, 26).CurrentRegion.Clear
　Set Sh = Nothing
　Application.ScreenUpdating = True
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。　