Excel マクロ2(画面作成用)

###  Excelの画面作成（部品部分の組み合わせ）

---

### 前提
下記記載のマクロは、**Office365(2024/12/01)時点**のものを利用しています。
マクロは、生成AIChat Gptを利用して生成したものを修正しました。
実行結果は確認済みです。

---

### 経緯
顧客先より、画面を複数のコンポーネント（部品）に分けて、
ステータスや分類ごとに表示されるレイアウトが違うといった具合で、かなりややこしい作りとなりました。
最初は、手で作っておりましたが、マクロを作成して、管理することとしました。

---

### 注意事項
 ・サンプルのExcelファイルをダウンロードをしてください。
https://github.com/HiHiroyoshi/excelAndCommentMacro-ScreenComportnent-
（ファイル名20241201ScreenLayout.xlsx）
マクロは、20241201_macroProgram.txtに記載しています。


 ・マクロの有効化
 　マクロを実行するには、Excelで「マクロ有効化」の設定が必要です。

---

### 手順概要
A. [準備）開発メニューを表示](#a-準備開発メニューを表示)  
B. [VBAマクロの操作画面を表示](#b-vbaマクロの操作画面を表示)  
C. [マクロを貼り付けて、実行](#c-マクロを貼り付けて実行)  
D. [ファイルの保存を行う](#d-ファイルの保存を行う)
E. [まとめ](#e-まとめ)

---
### A. 準備）開発メニューを表示
（既に**開発**メニューがある場合は、不要です）。
1.Excelを開く

2.**ファイル**メニューをクリック

3.**オプション**をクリック（筆者ノートPCでは、その他の中にありました）

4.Excelの**オプション**の**リボンのユーザー設定**をクリック

5.リボンのカスタマイズをします。右側リボンのユーザー設定（B）のメインタブの**開発**にチェックを入れる
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/c4688856-6882-9bb2-b792-019488a037b9.png)

6.**OK**をクリック

7.開発メニューが表示されます。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/ae50ed05-8c37-0a98-07ee-818b260d9df5.png)

---

### B. VBAマクロの操作画面を表示
1.**開発**タブをクリック

2.表示される**Visual Basic**をクリック

3.新たに画面が表示されます。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/0663a0af-1d86-e4a7-6f8c-6f966f678a44.png)
（難しい印象を持たれる方もいるかと思いますが、行う操作は、ごく一部です。）

4.上側**挿入**メニューをクリック
![スクリーンショット 2024-11-30 093123.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/b28f471d-e857-52a3-2f06-635937d7efdc.png)

5.**標準モジュール**をクリック
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/8bfc9317-16e7-f03e-0428-8e1fad7d7015.png)


![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/20474f5f-cbab-4667-0445-fb540294b7ed.png)

表示された画面に、マクロを貼り付けて実行する形となります。

---

### C. マクロを貼り付けて、実行
1.下記のプログラムをコピー（あるいは、gitのtxtファイルの内容をコピー）して、貼り付けをしてください。
```
Sub CreateSheetsWithData()
    Dim wsSheetList As Worksheet
    Dim wsMaster As Worksheet
    Dim wsSheet2 As Worksheet
    Dim newWorkbook As Workbook
    Dim newSheet As Worksheet
    Dim lastRowSheetList As Long
    Dim lastColSheetList As Long
    Dim i As Long, j As Long
    Dim sheetName As String
    Dim componentSheet As String
    Dim identifier As String
    Dim startPos As String, endPos As String
    Dim rowCount As Long, colCount As Long
    Dim targetRange As Range
    Dim pasteRow As Long
    Dim partSheetName As String
    
    ' 元のシートを設定
    Set wsSheetList = ThisWorkbook.Sheets("SheetList")
    Set wsMaster = ThisWorkbook.Sheets("Master")
    
    ' SheetListの最終行と列を取得
    lastRowSheetList = wsSheetList.Cells(wsSheetList.Rows.Count, "C").End(xlUp).Row
    lastColSheetList = wsSheetList.Cells(2, wsSheetList.Columns.Count).End(xlToLeft).Column
    
    ' 新しいブックを作成
    Set newWorkbook = Workbooks.Add
    
    ' シートリストをループ
    For i = 4 To lastRowSheetList
        sheetName = wsSheetList.Cells(i, "C").Value
        If sheetName <> "" Then
            ' 新しいシートを作成
            Set newSheet = newWorkbook.Sheets.Add(After:=newWorkbook.Sheets(newWorkbook.Sheets.Count))
            newSheet.Name = sheetName
            
            ' 必要な部品情報を取得
            For j = 4 To lastColSheetList
                componentSheet = wsSheetList.Cells(2, j).Value
                identifier = wsSheetList.Cells(i, j).Value
                
                ' 識別番号が入力されている場合、Masterシートを検索
                If componentSheet <> "" And identifier <> "" Then
                    Dim k As Long
                    Dim lastRowMaster As Long
                    lastRowMaster = wsMaster.Cells(wsMaster.Rows.Count, "C").End(xlUp).Row
                    
                    ' Masterシートを検索
                    For k = 3 To lastRowMaster
                        ' 部品シート名と識別番号が一致する行を判定
                        If wsMaster.Cells(k, "C").Value = componentSheet And _
                           wsMaster.Cells(k, "D").Value = identifier Then
                            
                            ' 部品シート名を取得
                            partSheetName = wsMaster.Cells(k, "C").Value
                            Set wsSheet2 = ThisWorkbook.Sheets(partSheetName)
                            ' 対応するデータを取得
                            startPos = wsMaster.Cells(k, "E").Value
                            endPos = wsMaster.Cells(k, "H").Value
                            
                            ' 範囲をコピー
                            If startPos <> "" And endPos <> "" Then
                                On Error Resume Next ' エラー回避用
                                Set targetRange = wsSheet2.Range(startPos & ":" & endPos)
                                On Error GoTo 0
                                
                                If Not targetRange Is Nothing Then
                                    ' 貼り付け先の行を取得
                                    pasteRow = newSheet.Cells(newSheet.Rows.Count, 12).End(xlUp).Row + 1
                                    
                                    ' 部品シート名を記載
                                    newSheet.Cells(pasteRow, 1).Value = "部品シート名: " & partSheetName
                                    pasteRow = pasteRow + 1
                                    
                                    ' データを貼り付け
                                    targetRange.Copy
                                    newSheet.Cells(pasteRow, 12).PasteSpecial Paste:=xlPasteAll
                                End If
                            Else
                                Debug.Print "無効な範囲: " & startPos & " - " & endPos
                            End If
                        End If
                    Next k
                End If
            Next j
        End If
    Next i
    
    ' 新しいブックを保存
    Application.CutCopyMode = False
    MsgBox "新しいブックが作成されました。" & vbCrLf & "内容を確認してください。", vbInformation
End Sub
```

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/1eb63432-eeb9-30b2-2146-c127fe7ba88d.png)



2.**実行**メニューをクリック
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/d8ecece6-2ecc-0c1e-8189-4fbf91a32f7f.png)

3.**Sub/ユーザーフォームの実行 F5**をクリック
→マクロが実行されます。

実行後、下記のポップアップが表示されます。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/e0794391-e2d8-6bc4-b481-aef50a65b252.png)

以上が、作成作業です。

---

### D. ファイルの保存を行う

マクロ実行後、Excelを保存する際に、下記の表示がされます。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3537494/0697751c-86d7-184d-3081-7d2071e5a9b7.png)
・マクロも含めて保存を行う（拡張子.xlsm）
・実行したマクロは保存しない(拡張子.xlsx)
どちらかでの保存という形となります。
→実行したマクロは保存しないため、**機能の保存と消去**をクリックしてください。

以上となります。

---

### E. まとめ

マクロを利用することで、手動で同じような画面構成を変更や修正する手間が省けます。