VBAを何かに例えるとして下記のように考えてみました。
VBAを学び始めると、Setステートメントという壁にぶつかります。
「なぜ = じゃダメなのか？」 「オブジェクトって結局なんなのか？」
ここで、ある学習者の方から、本質を突いた素晴らしい定義を伺いました。
オブジェクトとは、機能（〇 が何かをする）とデータ（〇 の状態がこうである）を持つ型である。 Set とは、その「〇」の部分を、「実際に存在しているモノ（実体）」と紐付ける（割り当て）ための命令である。
この観点を中心に、VBAの概念を「レストランの運営」に例えて、この記事を再構成します。
レストランに例えるVBAの基本要素
- プロジェクト
VBA: Excelファイル全体 (.xlsm)
例え: レストランの「店舗（建物）」そのもの。
- モジュール
VBA: コードを格納する場所（目的別に分ける）
例え: 「業務マニュアル」の束（例: ホール用、キッチン用）
- ステートメント
VBA: 1行1行の具体的な命令文
例え: マニュアル内の指示（例: 「塩をひとつまみ入れる」）
データ型変数とオブジェクト型変数の違い
ここからが本題です。VBAには2種類の「いれもの（変数）」があります。
- データ型変数 (String, Longなど)
VBA: 単純な「値（情報）」を入れる箱
例え: 使い捨ての「注文メモ用紙」
■ 処理: = (イコール) を使う
例: order = "ビール"
例え: メモ用紙に「ビール」という文字を書き写す（コピー）
特徴: メモ用紙自体は何も機能を持っていません。ただの「情報」です。
- オブジェクト型変数 (Worksheet, Rangeなど)
ここであの「〇」が登場します。
① 「〇」の部分 (オブジェクト型変数)
VBA: Dim ws As Worksheet
例え: 「本日の調理担当」という**「空の名札（役割）」**
解説: これが「〇」の部分です。宣言しただけでは、〇は空っぽです。「〇が調理する」ことも「〇の状態」も分かりません。
② 「実際に存在しているモノ」 (オブジェクトの実体)
VBA: Worksheets("Sheet1") や Range("A1")
例え: ベテランの「鈴木シェフ」や「5番テーブル」そのもの
解説: こちらが「実体」です。この実体こそが、機能とデータを持っています。
◆ プロパティ (〇の状態)
VBA: .Name (名前), .Value (値)
例え: 鈴木シェフの「名前」や、5番テーブルの「現在の会計金額」
◆ メソッド (〇がする事)
VBA: .Select (選択する), .ClearContents (中身を消す)
例え: 鈴木シェフが「調理する」動作や、5番テーブルを「片付ける」動作
- Set (「〇」と「実体」の紐付け)
VBA: Set ws = Worksheets("Sheet1")
例え: 「〇（調理担当の名札）」を「実体（鈴木シェフ本人）」に**任命（Set）**し、紐付ける。
Set を使って初めて、「〇」と「実体」が結びつきます。 この紐付けが完了して初めて、私たちは ws という変数（名札）を通して、「鈴木シェフ（実体）」に以下のような指示が出せるようになります。
ws.Activate （〇 が 何かをする ＝ 調理担当、調理場に立て！）
Debug.Print ws.Name （〇 の 状態 を確認 ＝ 調理担当、名前を言え！）
■ もし = を使ったら？
ws = Worksheets("Sheet1")
役割: 値のコピー（書き写し）
例え: 名札に「Sheet1」という文字を書くだけ。
結果: 鈴木シェフ（実体）は任命されていないので、ws.Activate と命令しても誰も動いてくれません。
【まとめ】データ型とオブジェクト型の決定的な違い
（※表の代わりに箇条書きで比較します）
■ データ型変数 (String, Longなど)
役割: **「値（情報）」**そのものを入れる箱
例え: 注文メモ用紙 📝
使う命令: = (イコール)
命令の意味: 値の**「コピー（書き写し）」**
具体例 (VBA): myText = "ビール"
具体例 (例え): メモ用紙に「ビール」という文字を書く。
特徴: メモ用紙自体は何も機能を持たない。
■ オブジェクト型変数 (Worksheet, Rangeなど)
役割: **「実体（オブジェクト）」**を操作するための「役割(〇)」を入れる箱
例え: 「本日の調理担当」という名札 📛
使う命令: Set (セット)
命令の意味: 実体の**「割り当て（紐付け）」**
具体例 (VBA): Set mySheet = Worksheets("Sheet1")
具体例 (例え): 「調理担当」の名札を「鈴木シェフ」本人に渡す。
特徴: 名札を渡された本人（実体）は「調理する」などの機能を持つ。
'================================================================================
' 機能概要：指定フォルダ内のExcelファイルから自由記述テスト結果を集計する (安定版)
' 作成日 ：2025/10/21
' 更新日 ：2025/10/21 - Dir関数を使用する方法に変更し、安定性を向上
'================================================================================
Sub 集計_自由記述テスト結果()
' --- 定数定義 (★ここを環境に合わせて修正してください) ---
Const C_STR_FOLDER_PATH As String = "C:\Users\hyshi\Desktop\集計フォルダ\" '★結果ファイルが入っているフォルダパス
Const C_STR_SHEET_NAME As String = "商品マスタ" '★取得対象のシート名
Const C_STR_COLUMN_LETTER As String = "C" '★取得対象の列（アルファベット）
Const C_STR_MASTER_SHEET_NAME As String = "集計結果" '★結果を出力するシート名
' ----------------------------------------------------------------
' --- 変数定義 ---
Dim wb_Src As Workbook
Dim ws_Src As Worksheet
Dim ws_Master As Worksheet
Dim rng_Copy As Range
Dim str_FileName As String
Dim str_FilePath As String
Dim lng_SrcLastRow As Long
Dim lng_NextCol As Long
' --- 初期設定 ---
Application.ScreenUpdating = False
' フォルダの存在チェック (Dir関数を使用)
If Dir(C_STR_FOLDER_PATH, vbDirectory) = "" Then
MsgBox "指定されたフォルダが見つかりません。" & vbCrLf & C_STR_FOLDER_PATH, vbExclamation
Exit Sub
End If
' 集計シートの準備
On Error Resume Next
Set ws_Master = ThisWorkbook.Sheets(C_STR_MASTER_SHEET_NAME)
On Error GoTo 0
If ws_Master Is Nothing Then
Set ws_Master = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws_Master.Name = C_STR_MASTER_SHEET_NAME
End If
ws_Master.Cells.Clear
ws_Master.Range("A1").Value = "回答" '見出し
' --- メイン処理：ファイル巡回 (Dir関数を使用) ---
lng_NextCol = 2 'B列からデータを貼り付け開始
str_FileName = Dir(C_STR_FOLDER_PATH & "*.xls*") '最初のExcelファイルを取得
Do While str_FileName <> ""
str_FilePath = C_STR_FOLDER_PATH & str_FileName
Set wb_Src = Workbooks.Open(str_FilePath, ReadOnly:=True)
' 対象シートの存在チェック
On Error Resume Next
Set ws_Src = wb_Src.Sheets(C_STR_SHEET_NAME)
On Error GoTo 0
If Not ws_Src Is Nothing Then
' コピー対象列の最終行を取得
lng_SrcLastRow = ws_Src.Cells(ws_Src.Rows.Count, C_STR_COLUMN_LETTER).End(xlUp).Row
If lng_SrcLastRow > 1 Then '見出し行以外にデータがある場合
' コピー範囲を設定
Set rng_Copy = ws_Src.Range(C_STR_COLUMN_LETTER & "2:" & C_STR_COLUMN_LETTER & lng_SrcLastRow)
' ファイル名をヘッダーとして設定
ws_Master.Cells(1, lng_NextCol).Value = str_FileName
' 値をコピーして貼り付け
ws_Master.Cells(2, lng_NextCol).Resize(rng_Copy.Rows.Count).Value = rng_Copy.Value
' 次の列へ
lng_NextCol = lng_NextCol + 1
End If
End If
wb_Src.Close SaveChanges:=False
Set ws_Src = Nothing 'リセット
str_FileName = Dir() '次のファイルを取得
Loop
' --- 終了処理 ---
ws_Master.Columns.AutoFit
Application.ScreenUpdating = True
Set wb_Src = Nothing
Set ws_Master = Nothing
MsgBox "集計が完了しました。", vbInformation
End Sub
'================================================================================
' 機能概要：指定フォルダ内のExcelファイルから特定名のシートをすべて収集し、
' コピーしたシートを元のファイル名にリネームする
' 作成日 ：2025/10/21
' 更新日 ：2025/10/21 - ファイル名からのシート名抽出ロジックを強化
'================================================================================
Sub シート収集_ワークフロー()
' --- 定数定義 (★ここを環境に合わせて修正してください) ---
Const C_STR_FOLDER_PATH As String = "C:\Users\hyshi\Desktop\集計フォルダ\" '★対象ファイルが入っているフォルダパス
Const C_STR_SHEET_NAME_TO_COPY As String = "クロスABC" '★収集したいシートの名前
' --- ★シート名の文字数設定 ---
Const C_LNG_START_CHAR As Long = 1 '★シート名にするファイル名の開始文字位置
Const C_LNG_MAX_LENGTH As Long = 31 '★シート名にする最大文字数 (31以下を推奨)
' ----------------------------------------------------------------
' --- 変数定義 ---
Dim wb_Src As Workbook
Dim ws_Src As Worksheet
Dim str_FileName As String
Dim str_FilePath As String
Dim lng_CollectedCount As Long
Dim str_NewSheetName As String
Dim str_BaseName As String
' --- 初期設定 ---
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'シート名重複時の警告を非表示
lng_CollectedCount = 0
' フォルダの存在チェック
If Dir(C_STR_FOLDER_PATH, vbDirectory) = "" Then
MsgBox "指定されたフォルダが見つかりません。" & vbCrLf & C_STR_FOLDER_PATH, vbExclamation
GoTo Finalize '終了処理へ
End If
' --- メイン処理：ファイル巡回 (Dir関数を使用) ---
str_FileName = Dir(C_STR_FOLDER_PATH & "*.xls*") '最初のExcelファイルを取得
Do While str_FileName <> ""
'このマクロが書かれているブック自体は処理しない
If str_FileName <> ThisWorkbook.Name Then
str_FilePath = C_STR_FOLDER_PATH & str_FileName
Set wb_Src = Workbooks.Open(str_FilePath, ReadOnly:=True)
' 収集対象のシートが存在するかチェック
On Error Resume Next
Set ws_Src = wb_Src.Sheets(C_STR_SHEET_NAME_TO_COPY)
On Error GoTo 0
' シートが存在した場合、コピー処理を実行
If Not ws_Src Is Nothing Then
' 1. シートをコピー
ws_Src.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
lng_CollectedCount = lng_CollectedCount + 1
' 2. ファイル名からシート名として有効な名前を作成
' 拡張子を除去
str_BaseName = Left(str_FileName, InStrRev(str_FileName, ".") - 1)
' 指定された位置から指定文字数分を抽出
If Len(str_BaseName) >= C_LNG_START_CHAR Then
str_NewSheetName = Mid(str_BaseName, C_LNG_START_CHAR, C_LNG_MAX_LENGTH)
Else
' ファイル名の長さが開始位置に満たない場合は、ファイル名をそのまま使う
str_NewSheetName = str_BaseName
End If
' シート名に使えない文字(\ / ? * [ ] :)をまとめて除去
str_NewSheetName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(str_NewSheetName, "\", ""), "/", ""), "?", ""), "*", ""), "[", ""), "]", ""), ":", "")
' 念のため31文字以内に最終調整 (C_LNG_MAX_LENGTH が31を超える場合を考慮)
If Len(str_NewSheetName) > 31 Then
str_NewSheetName = Left(str_NewSheetName, 31)
End If
' 3. コピーされたシートの名前を変更
On Error Resume Next '名前の重複エラーをハンドルするため
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = str_NewSheetName
If Err.Number <> 0 Then
' 万が一名前が重複した場合は、末尾に連番を付与してリネーム
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = str_NewSheetName & "_" & lng_CollectedCount
Err.Clear
End If
On Error GoTo 0
End If
wb_Src.Close SaveChanges:=False
Set ws_Src = Nothing '変数をリセット
End If
str_FileName = Dir() '次のファイルを取得
Loop
' --- 終了処理 ---
Finalize:
Application.ScreenUpdating = True
Application.DisplayAlerts = True '警告を再表示
Set wb_Src = Nothing
MsgBox lng_CollectedCount & "枚のシートを収集しました。", vbInformation
End Sub