Tableauデータソース解析マクロ

Option Explicit

' モジュールレベル変数（作成したシート名を保持）
Private createdSheets As Collection

Sub AnalyzeTableauDatasourcesV2()
    Dim xmlDoc As Object
    Dim xmlFilePath As String
    Dim datasourcesNode As Object
    Dim datasourceNode As Object
    Dim datasourceName As String
    Dim datasourceCaption As String
    Dim wsTables As Worksheet
    Dim tableRow As Long
    Dim datasourceCount As Long

    ' 作成したシート名を記録するコレクションを初期化
    Set createdSheets = New Collection

    ' ファイル選択ダイアログを表示
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Tableauワークブックファイル(.twb)を選択してください"
        .Filters.Clear
        .Filters.Add "Tableauワークブック", "*.twb"
        .Filters.Add "XMLファイル", "*.xml"
        .AllowMultiSelect = False

        If .Show = -1 Then
            xmlFilePath = .SelectedItems(1)
        Else
            MsgBox "ファイルが選択されませんでした。", vbExclamation
            Exit Sub
        End If
    End With

    ' XML DOMオブジェクトを作成
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")

    ' XML設定
    xmlDoc.async = False
    xmlDoc.validateOnParse = False
    xmlDoc.resolveExternals = False
    xmlDoc.preserveWhiteSpace = True

    ' テーブル情報シートを準備
    PrepareTablesSheet wsTables
    tableRow = 2
    datasourceCount = 0

    ' XMLファイルを読み込み
    If xmlDoc.Load(xmlFilePath) Then
        Debug.Print "XMLファイルの読み込みに成功しました: " & xmlFilePath

        ' <datasources>要素を取得
        Set datasourcesNode = xmlDoc.getElementsByTagName("datasources")(0)

        If Not datasourcesNode Is Nothing Then
            ' <datasource>要素分ループ
            For Each datasourceNode In datasourcesNode.ChildNodes
                If datasourceNode.NodeType = 1 And datasourceNode.nodeName = "datasource" Then
                    datasourceName = GetAttributeValue(datasourceNode, "name")

                    ' Parameters以外のデータソースを処理
                    If datasourceName <> "Parameters" Then
                        datasourceCount = datasourceCount + 1
                        datasourceCaption = GetAttributeValue(datasourceNode, "caption")

                        ' 表示名がない場合はname属性を使用
                        If datasourceCaption = "" Then
                            datasourceCaption = datasourceName
                        End If

                        Debug.Print "データソース処理中: " & datasourceCaption

                        ' テーブル情報を共通シートに出力
                        tableRow = ProcessDatasourceTablesV2(datasourceNode, wsTables, tableRow, datasourceCaption)

                        ' データソースごとのシートを作成して基本情報とフィールド情報を出力
                        ProcessDatasourceDetailSheet datasourceNode, datasourceCaption

                    End If
                End If
            Next datasourceNode
        End If

        ' テーブル情報シートの列幅を自動調整
        wsTables.Columns("A:H").AutoFit

        ' 計算式内のフィールド名を置換
        ReplaceFieldNamesInFormulas

        ' テーブル情報シートの重複行を削除
        RemoveDuplicateTableRows wsTables

        MsgBox "データソース解析が完了しました。" & vbCrLf & _
               "処理したデータソース数: " & datasourceCount, vbInformation

    Else
        MsgBox "XMLファイルの読み込みに失敗しました: " & xmlFilePath & vbCrLf & _
               "エラー: " & xmlDoc.parseError.reason, vbCritical
    End If

    ' オブジェクトを解放
    Set datasourceNode = Nothing
    Set datasourcesNode = Nothing
    Set xmlDoc = Nothing
End Sub

' テーブル情報シートを準備
Sub PrepareTablesSheet(ByRef wsTables As Worksheet)
    On Error Resume Next
    Set wsTables = ThisWorkbook.Sheets("テーブル情報")
    If wsTables Is Nothing Then
        Set wsTables = ThisWorkbook.Sheets.Add
        wsTables.Name = "テーブル情報"
    Else
        wsTables.Cells.Clear
    End If
    On Error GoTo 0

    ' 作成したシート名をコレクションに追加
    On Error Resume Next
    createdSheets.Add wsTables.Name
    On Error GoTo 0

    ' ヘッダー設定
    With wsTables
        .Range("A1").Value = "データソース名"
        .Range("B1").Value = "テーブル名"
        .Range("C1").Value = "テーブル種別"
        .Range("D1").Value = "物理テーブル名"
        .Range("E1").Value = "スキーマ"
        .Range("F1").Value = "接続名"
        .Range("G1").Value = "完全参照"
        .Range("H1").Value = "ソースタイプ"

        .Range("A1:H1").Font.Bold = True
        .Range("A1:H1").Interior.ColorIndex = 15
        .Range("A1:H1").Borders.LineStyle = xlContinuous
    End With
End Sub

' テーブル情報を処理（共通シート）
Function ProcessDatasourceTablesV2(datasourceNode As Object, ws As Worksheet, rowNum As Long, datasourceName As String) As Long
    Dim relationNodes As Object
    Dim relationNode As Object
    Dim tableName As String
    Dim tableType As String
    Dim physicalTable As String
    Dim tableSchema As String
    Dim connectionName As String
    Dim sqlText As String
    Dim currentRow As Long

    currentRow = rowNum

    ' type='table'のrelation要素を取得
    Set relationNodes = datasourceNode.selectNodes(".//relation[@type='table']")

    If Not relationNodes Is Nothing Then
        For Each relationNode In relationNodes
            tableName = GetAttributeValue(relationNode, "name")
            tableType = GetAttributeValue(relationNode, "type")
            physicalTable = GetAttributeValue(relationNode, "table")
            connectionName = GetAttributeValue(relationNode, "connection")

            ' テーブル情報をパース
            ParseTableInfo physicalTable, tableSchema, physicalTable

            ' スキーマ名がExtractの場合は除外
            If LCase(tableSchema) <> "extract" Then
                ' ワークシートに出力
                With ws
                    .Cells(currentRow, 1).Value = datasourceName
                    .Cells(currentRow, 2).Value = tableName
                    .Cells(currentRow, 3).Value = tableType
                    .Cells(currentRow, 4).Value = physicalTable
                    .Cells(currentRow, 5).Value = tableSchema
                    .Cells(currentRow, 6).Value = connectionName
                    .Cells(currentRow, 7).Value = tableSchema & "." & physicalTable
                    .Cells(currentRow, 8).Value = "Table"

                    ' 枠線を設定
                    .Range(.Cells(currentRow, 1), .Cells(currentRow, 8)).Borders.LineStyle = xlContinuous
                End With

                currentRow = currentRow + 1
            End If
        Next relationNode
    End If

    ' type='text'のrelation要素を処理（カスタムSQL）
    Set relationNodes = datasourceNode.selectNodes(".//relation[@type='text']")

    If Not relationNodes Is Nothing Then
        For Each relationNode In relationNodes
            tableName = GetAttributeValue(relationNode, "name")
            sqlText = relationNode.text

            If sqlText <> "" Then
                ' SQLテキストからテーブル情報を抽出
                currentRow = ExtractTablesFromSQL(sqlText, ws, currentRow, datasourceName)
            End If
        Next relationNode
    End If

    ProcessDatasourceTablesV2 = currentRow
End Function

' テーブル情報をパース
Sub ParseTableInfo(tableInfo As String, ByRef schema As String, ByRef tableName As String)
    ' [schema].[table] 形式をパース
    Dim parts() As String

    ' 角括弧を削除
    tableInfo = Replace(tableInfo, "[", "")
    tableInfo = Replace(tableInfo, "]", "")

    ' ピリオドで分割
    parts = Split(tableInfo, ".")

    If UBound(parts) >= 1 Then
        schema = parts(0)
        tableName = parts(1)
    Else
        schema = ""
        tableName = tableInfo
    End If
End Sub

' SQLテキストからテーブル情報を抽出
Function ExtractTablesFromSQL(sqlText As String, ws As Worksheet, rowNum As Long, datasourceName As String) As Long
    Dim regex As Object
    Dim matches As Object
    Dim match As Object
    Dim schema As String
    Dim tableName As String
    Dim currentRow As Long

    currentRow = rowNum
    Set regex = CreateObject("VBScript.RegExp")

    ' FROM句とJOIN句のテーブルを検索
    regex.Pattern = "(?:FROM|JOIN)\s+""?([^"".\s]+)""?\.""?([^"".\s]+)""?"
    regex.Global = True
    regex.IgnoreCase = True

    Set matches = regex.Execute(sqlText)

    For Each match In matches
        If match.SubMatches.Count >= 2 Then
            schema = match.SubMatches(0)
            tableName = match.SubMatches(1)

            ' スキーマ名がExtractの場合は除外
            If LCase(schema) <> "extract" Then
                ' ワークシートに出力
                With ws
                    .Cells(currentRow, 1).Value = datasourceName
                    .Cells(currentRow, 2).Value = "Custom SQL"
                    .Cells(currentRow, 3).Value = "text"
                    .Cells(currentRow, 4).Value = tableName
                    .Cells(currentRow, 5).Value = schema
                    .Cells(currentRow, 6).Value = ""
                    .Cells(currentRow, 7).Value = schema & "." & tableName
                    .Cells(currentRow, 8).Value = "SQL"

                    ' 枠線を設定
                    .Range(.Cells(currentRow, 1), .Cells(currentRow, 8)).Borders.LineStyle = xlContinuous
                End With

                currentRow = currentRow + 1
            End If
        End If
    Next match

    ExtractTablesFromSQL = currentRow
End Function

' データソースごとの詳細シートを作成
Sub ProcessDatasourceDetailSheet(datasourceNode As Object, datasourceName As String)
    Dim ws As Worksheet
    Dim sheetName As String
    Dim currentRow As Long

    ' シート名を作成（Excelのシート名制限31文字を考慮）
    sheetName = Left(CleanSheetName(datasourceName), 31)

    ' 既存のシートを確認または新規作成
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add
        ws.Name = sheetName
    Else
        ws.Cells.Clear
    End If
    On Error GoTo 0

    ' 作成したシート名をコレクションに追加
    On Error Resume Next
    createdSheets.Add ws.Name
    On Error GoTo 0

    ' 基本情報セクションを作成
    currentRow = CreateBasicInfoSection(datasourceNode, ws, datasourceName)

    ' 空行を追加
    currentRow = currentRow + 2

    ' フィールド情報セクションを作成
    CreateFieldInfoSection datasourceNode, ws, currentRow

    ' 列幅を自動調整
    ws.Columns("A:H").AutoFit
End Sub

' 基本情報セクションを作成
Function CreateBasicInfoSection(datasourceNode As Object, ws As Worksheet, datasourceName As String) As Long
    Dim connectionNode As Object
    Dim namedConnectionNode As Object
    Dim connectionClass As String
    Dim server As String
    Dim dbname As String
    Dim schema As String
    Dim port As String
    Dim username As String
    Dim authentication As String
    Dim sslmode As String
    Dim rowNum As Long

    rowNum = 1

    ' セクションタイトル
    With ws
        .Range("A" & rowNum).Value = "【基本情報】"
        .Range("A" & rowNum).Font.Bold = True
        .Range("A" & rowNum).Font.Size = 12
        .Range("A" & rowNum).Interior.ColorIndex = 35
    End With

    rowNum = rowNum + 1

    ' connection要素を取得
    Set connectionNode = datasourceNode.selectSingleNode("connection")

    If Not connectionNode Is Nothing Then
        connectionClass = GetAttributeValue(connectionNode, "class")

        ' federatedの場合、named-connectionから詳細を取得
        If connectionClass = "federated" Then
            Set namedConnectionNode = connectionNode.selectSingleNode(".//connection[@class!='federated']")
            If Not namedConnectionNode Is Nothing Then
                connectionClass = GetAttributeValue(namedConnectionNode, "class")
                server = GetAttributeValue(namedConnectionNode, "server")
                dbname = GetAttributeValue(namedConnectionNode, "dbname")
                schema = GetAttributeValue(namedConnectionNode, "schema")
                port = GetAttributeValue(namedConnectionNode, "port")
                username = GetAttributeValue(namedConnectionNode, "username")
                authentication = GetAttributeValue(namedConnectionNode, "authentication")
                sslmode = GetAttributeValue(namedConnectionNode, "sslmode")
            End If
        Else
            server = GetAttributeValue(connectionNode, "server")
            dbname = GetAttributeValue(connectionNode, "dbname")
            schema = GetAttributeValue(connectionNode, "schema")
            port = GetAttributeValue(connectionNode, "port")
            username = GetAttributeValue(connectionNode, "username")
            authentication = GetAttributeValue(connectionNode, "authentication")
            sslmode = GetAttributeValue(connectionNode, "sslmode")
        End If
    End If

    ' 基本情報を出力
    With ws
        .Range("A" & rowNum).Value = "データソース名:"
        .Range("B" & rowNum).Value = datasourceName
        rowNum = rowNum + 1

        .Range("A" & rowNum).Value = "接続タイプ:"
        .Range("B" & rowNum).Value = connectionClass
        rowNum = rowNum + 1

        If server <> "" Then
            .Range("A" & rowNum).Value = "サーバー:"
            .Range("B" & rowNum).Value = server
            rowNum = rowNum + 1
        End If

        If dbname <> "" Then
            .Range("A" & rowNum).Value = "データベース:"
            .Range("B" & rowNum).Value = dbname
            rowNum = rowNum + 1
        End If

        If schema <> "" Then
            .Range("A" & rowNum).Value = "スキーマ:"
            .Range("B" & rowNum).Value = schema
            rowNum = rowNum + 1
        End If

        If port <> "" Then
            .Range("A" & rowNum).Value = "ポート:"
            .Range("B" & rowNum).Value = port
            rowNum = rowNum + 1
        End If

        If username <> "" Then
            .Range("A" & rowNum).Value = "ユーザー名:"
            .Range("B" & rowNum).Value = username
            rowNum = rowNum + 1
        End If

        If authentication <> "" Then
            .Range("A" & rowNum).Value = "認証方式:"
            .Range("B" & rowNum).Value = authentication
            rowNum = rowNum + 1
        End If

        If sslmode <> "" Then
            .Range("A" & rowNum).Value = "SSL設定:"
            .Range("B" & rowNum).Value = sslmode
            rowNum = rowNum + 1
        End If
    End With

    CreateBasicInfoSection = rowNum
End Function

' フィールド情報セクションを作成
Sub CreateFieldInfoSection(datasourceNode As Object, ws As Worksheet, startRow As Long)
    Dim metadataRecords As Object
    Dim metadataRecord As Object
    Dim columnNodes As Object
    Dim columnNode As Object
    Dim localName As String
    Dim remoteName As String
    Dim parentName As String
    Dim localType As String
    Dim caption As String
    Dim calcFormula As String
    Dim currentRow As Long

    currentRow = startRow

    ' セクションタイトル
    With ws
        .Range("A" & currentRow).Value = "【フィールド情報】"
        .Range("A" & currentRow).Font.Bold = True
        .Range("A" & currentRow).Font.Size = 12
        .Range("A" & currentRow).Interior.ColorIndex = 35
    End With

    currentRow = currentRow + 1

    ' ヘッダー行
    With ws
        .Range("A" & currentRow).Value = "フィールド名"
        .Range("B" & currentRow).Value = "物理フィールド名/キャプション"
        .Range("C" & currentRow).Value = "ソーステーブル"
        .Range("D" & currentRow).Value = "データ型"
        .Range("E" & currentRow).Value = "フィールド種別"
        .Range("F" & currentRow).Value = "計算式"

        .Range("A" & currentRow & ":F" & currentRow).Font.Bold = True
        .Range("A" & currentRow & ":F" & currentRow).Interior.ColorIndex = 15
        .Range("A" & currentRow & ":F" & currentRow).Borders.LineStyle = xlContinuous
    End With

    currentRow = currentRow + 1

    ' metadata-record要素を処理（物理フィールド情報）
    Set metadataRecords = datasourceNode.selectNodes(".//metadata-records/metadata-record[@class='column']")

    If Not metadataRecords Is Nothing Then
        For Each metadataRecord In metadataRecords
            localName = GetNodeTextValue(metadataRecord, "local-name")
            remoteName = GetNodeTextValue(metadataRecord, "remote-name")
            parentName = GetNodeTextValue(metadataRecord, "parent-name")
            localType = GetNodeTextValue(metadataRecord, "local-type")

            ' ワークシートに出力
            With ws
                .Cells(currentRow, 1).Value = localName
                .Cells(currentRow, 2).Value = remoteName
                .Cells(currentRow, 3).Value = parentName
                .Cells(currentRow, 4).Value = localType
                .Cells(currentRow, 5).Value = "物理フィールド"
                .Cells(currentRow, 6).Value = ""

                ' 枠線を設定
                .Range(.Cells(currentRow, 1), .Cells(currentRow, 6)).Borders.LineStyle = xlContinuous
            End With

            currentRow = currentRow + 1
        Next metadataRecord
    End If

    ' column要素を処理（計算フィールドや別名）
    Set columnNodes = datasourceNode.selectNodes("column")

    If Not columnNodes Is Nothing Then
        For Each columnNode In columnNodes
            localName = GetAttributeValue(columnNode, "name")
            caption = GetAttributeValue(columnNode, "caption")
            localType = GetAttributeValue(columnNode, "datatype")

            ' 計算式があるかチェック
            Dim calcNode As Object
            Set calcNode = columnNode.selectSingleNode("calculation")

            If Not calcNode Is Nothing Then
                calcFormula = GetAttributeValue(calcNode, "formula")
            Else
                calcFormula = ""
            End If

            ' ワークシートに出力
            With ws
                .Cells(currentRow, 1).Value = localName
                .Cells(currentRow, 2).Value = caption
                .Cells(currentRow, 3).Value = ""
                .Cells(currentRow, 4).Value = localType
                If Not calcNode Is Nothing Then
                    .Cells(currentRow, 5).Value = "計算フィールド"
                Else
                    .Cells(currentRow, 5).Value = "別名フィールド"
                End If
                .Cells(currentRow, 6).Value = calcFormula

                ' 枠線を設定
                .Range(.Cells(currentRow, 1), .Cells(currentRow, 6)).Borders.LineStyle = xlContinuous
            End With

            currentRow = currentRow + 1
        Next columnNode
    End If
End Sub

' シート名をクリーンアップ
Function CleanSheetName(sheetName As String) As String
    Dim invalidChars As Variant
    Dim i As Integer
    Dim cleanName As String

    cleanName = sheetName

    ' Excelのシート名で使えない文字を置換
    invalidChars = Array("\", "/", "?", "*", "[", "]", ":")

    For i = 0 To UBound(invalidChars)
        cleanName = Replace(cleanName, invalidChars(i), "_")
    Next i

    CleanSheetName = cleanName
End Function

' 属性値を安全に取得
Function GetAttributeValue(node As Object, attributeName As String) As String
    Dim attrValue As Variant

    On Error Resume Next
    attrValue = node.getAttribute(attributeName)
    On Error GoTo 0

    If IsNull(attrValue) Then
        GetAttributeValue = ""
    Else
        GetAttributeValue = CStr(attrValue)
    End If
End Function

' ノードのテキスト値を取得
Function GetNodeTextValue(parentNode As Object, nodeName As String) As String
    Dim childNode As Object
    Set childNode = parentNode.selectSingleNode(nodeName)

    If Not childNode Is Nothing Then
        GetNodeTextValue = childNode.text
    Else
        GetNodeTextValue = ""
    End If
End Function

' 計算式内のフィールド名を物理フィールド名に置換
Sub ReplaceFieldNamesInFormulas()
    Dim ws As Worksheet
    Dim sheetName As Variant
    Dim lastRow As Long
    Dim startRow As Long
    Dim i As Long
    Dim fieldName As String
    Dim physicalName As String
    Dim formulaRange As Range

    ' 作成したシート名のコレクションが空の場合は処理しない
    If createdSheets Is Nothing Then Exit Sub
    If createdSheets.Count = 0 Then Exit Sub

    ' 今回作成したワークシートのみループ
    For Each sheetName In createdSheets
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0

        ' シートが存在する場合のみ処理
        If Not ws Is Nothing Then
            ' "フィールド名" ヘッダーを持つ行を検索
            startRow = 0
            On Error Resume Next
            startRow = ws.Columns("A:A").Find(What:="フィールド名", LookIn:=xlValues, LookAt:=xlWhole).Row
            On Error GoTo 0

            ' "フィールド名" ヘッダーが見つかった場合のみ処理
            If startRow > 0 Then
                ' 最終行を取得
                lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

                ' データ行が存在する場合のみ処理
                If lastRow > startRow Then
                    ' データ行をループ（ヘッダー行の次の行から）
                    For i = startRow + 1 To lastRow
                        ' A列（フィールド名）の値を取得
                        fieldName = ws.Cells(i, 1).Value

                        ' B列（物理フィールド名/キャプション）の値を取得
                        physicalName = ws.Cells(i, 2).Value

                        ' A列とB列の両方に値がある場合のみ処理
                        If fieldName <> "" And physicalName <> "" Then
                            ' B列の値を [物理名] 形式に変換
                            physicalName = "[" & physicalName & "]"

                            ' F列（計算式）の全セルで置換
                            On Error Resume Next
                            Set formulaRange = ws.Columns("F:F")
                            formulaRange.Replace What:=fieldName, Replacement:=physicalName, _
                                               LookAt:=xlPart, SearchOrder:=xlByRows, _
                                               MatchCase:=False, SearchFormat:=False, _
                                               ReplaceFormat:=False
                            On Error GoTo 0
                        End If
                    Next i
                End If
            End If
        End If
    Next sheetName

    ' パラメータ解析結果シートを使った置換処理
    Dim wsParam As Worksheet
    Dim currentSheet As Worksheet
    Dim paramLastRow As Long
    Dim paramRow As Long
    Dim paramName As String
    Dim paramCaption As String

    ' パラメータ解析結果シートを取得
    On Error Resume Next
    Set wsParam = ThisWorkbook.Sheets("パラメータ解析結果")
    On Error GoTo 0

    ' パラメータ解析結果シートが存在する場合のみ処理
    If Not wsParam Is Nothing Then
        ' パラメータ解析結果シートの最終行を取得
        paramLastRow = wsParam.Cells(wsParam.Rows.Count, "A").End(xlUp).Row

        ' データ行が存在する場合のみ処理（2行目以降）
        If paramLastRow >= 2 Then
            ' 今回作成したワークシートをカレントシートとして保持しループ
            For Each sheetName In createdSheets
                On Error Resume Next
                Set currentSheet = ThisWorkbook.Sheets(sheetName)
                On Error GoTo 0

                ' カレントシートが存在する場合のみ処理
                If Not currentSheet Is Nothing Then
                    ' パラメータ解析結果シートのA列2行目からすべてループ
                    For paramRow = 2 To paramLastRow
                        ' A列（パラメータ名）の値を取得
                        paramName = wsParam.Cells(paramRow, 1).Value

                        ' B列（パラメータ表示名）の値を取得
                        paramCaption = wsParam.Cells(paramRow, 2).Value

                        ' A列とB列の両方に値がある場合のみ処理
                        If paramName <> "" And paramCaption <> "" Then
                            ' B列の値を [表示名] 形式に変換
                            paramCaption = "[" & paramCaption & "]"

                            ' カレントシートのF列（計算式）の全セルで置換
                            On Error Resume Next
                            Set formulaRange = currentSheet.Columns("F:F")
                            formulaRange.Replace What:=paramName, Replacement:=paramCaption, _
                                               LookAt:=xlPart, SearchOrder:=xlByRows, _
                                               MatchCase:=False, SearchFormat:=False, _
                                               ReplaceFormat:=False
                            On Error GoTo 0
                        End If
                    Next paramRow
                End If
            Next sheetName
        End If
    End If

    ' データ型の置換処理
    Dim dataTypeSheet As Worksheet
    Dim dataTypeLastRow As Long
    Dim dataTypeRow As Long
    Dim dataTypeCol As Long
    Dim dataTypeHeaderRow As Long
    Dim dataTypeValue As String
    Dim foundCell As Range

    ' 今回作成したワークシートをカレントシートとして保持しループ
    For Each sheetName In createdSheets
        On Error Resume Next
        Set dataTypeSheet = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0

        ' カレントシートが存在する場合のみ処理
        If Not dataTypeSheet Is Nothing Then
            ' "データ型" ヘッダーを持つセルを検索（シート全体から）
            Set foundCell = Nothing
            On Error Resume Next
            Set foundCell = dataTypeSheet.Cells.Find(What:="データ型", LookIn:=xlValues, LookAt:=xlWhole)
            On Error GoTo 0

            ' "データ型" ヘッダーが見つかった場合のみ処理
            If Not foundCell Is Nothing Then
                dataTypeCol = foundCell.Column
                dataTypeHeaderRow = foundCell.Row

                ' 最終行を取得
                dataTypeLastRow = dataTypeSheet.Cells(dataTypeSheet.Rows.Count, dataTypeCol).End(xlUp).Row

                ' データ行が存在する場合のみ処理（ヘッダー行の次の行以降）
                If dataTypeLastRow > dataTypeHeaderRow Then
                    ' データ行をループ（ヘッダー行の次の行から）
                    For dataTypeRow = dataTypeHeaderRow + 1 To dataTypeLastRow
                        dataTypeValue = dataTypeSheet.Cells(dataTypeRow, dataTypeCol).Value

                        ' データ型の値に応じて置換
                        Select Case LCase(Trim(dataTypeValue))
                            Case "boolean"
                                dataTypeSheet.Cells(dataTypeRow, dataTypeCol).Value = "ブール値"
                            Case "real"
                                dataTypeSheet.Cells(dataTypeRow, dataTypeCol).Value = "数値（小数）"
                            Case "integer"
                                dataTypeSheet.Cells(dataTypeRow, dataTypeCol).Value = "数値（整数）"
                            Case "date"
                                dataTypeSheet.Cells(dataTypeRow, dataTypeCol).Value = "日付"
                            Case "datetime"
                                dataTypeSheet.Cells(dataTypeRow, dataTypeCol).Value = "日付と時刻"
                            Case "string"
                                dataTypeSheet.Cells(dataTypeRow, dataTypeCol).Value = "文字列"
                        End Select
                    Next dataTypeRow
                End If
            End If
        End If
    Next sheetName
End Sub

' テーブル情報シートの重複行を削除
Sub RemoveDuplicateTableRows(ws As Worksheet)
    Dim lastRow As Long
    Dim currentRow As Long
    Dim compareRow As Long
    Dim isDuplicate As Boolean
    Dim col As Long

    ' シートが存在しない場合は終了
    If ws Is Nothing Then Exit Sub

    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' データ行が存在しない場合は終了（ヘッダー行のみの場合）
    If lastRow <= 1 Then Exit Sub

    ' 下の行から上に向かって処理（削除による行ズレを防ぐ）
    For currentRow = lastRow To 2 Step -1
        ' 現在の行より上の行と比較
        For compareRow = currentRow - 1 To 2 Step -1
            isDuplicate = True

            ' A列～H列すべてを比較
            For col = 1 To 8  ' A列=1, B列=2, ..., H列=8
                If ws.Cells(currentRow, col).Value <> ws.Cells(compareRow, col).Value Then
                    isDuplicate = False
                    Exit For
                End If
            Next col

            ' すべての列が一致した場合、重複とみなして行を削除
            If isDuplicate Then
                ws.Rows(currentRow).Delete
                Exit For  ' この行は削除されたので、次の行へ
            End If
        Next compareRow
    Next currentRow
End Sub