[測試] test

[d0641237 (資深訪客)]

--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 101.12.148.20 (臺灣)
※ 文章網址: https://www.ptt.cc/bbs/Test/M.1776691825.A.F63.html
※ 編輯: d0641237 (101.12.148.20 臺灣), 04/20/2026 21:41:51
Sub SummarizeAllSheetsMax()
    Dim ws As Worksheet
    Dim summaryWs As Worksheet
    Dim rowNum As Long
    Dim colArray As Variant
    Dim i As Integer

    ' 設定要檢查的欄位
    colArray = Array("Q", "R", "S", "T")

    ' 1. 建立或清空「最大值總彙整」工作表
    On Error Resume Next
    Set summaryWs = Sheets("最大值總彙整")
    If summaryWs Is Nothing Then
        Set summaryWs = Sheets.Add(Before:=Sheets(1))
        summaryWs.Name = "最大值總彙整"
    Else
        summaryWs.Cells.Clear
    End If
    On Error GoTo 0

    ' 2. 設定總表標題
    With summaryWs
        .Range("A1").Value = "工作表名稱"
        .Range("B1").Value = "Q欄最大值"
        .Range("C1").Value = "R欄最大值"
        .Range("D1").Value = "S欄最大值"
        .Range("E1").Value = "T欄最大值"
        .Range("A1:E1").Font.Bold = True
        .Range("A1:E1").Interior.Color = RGB(200, 200, 200)
    End With

    rowNum = 2

    ' 3. 遍歷每一個工作表進行計算
    For Each ws In ThisWorkbook.Worksheets
        ' 排除掉存放結果的那張表，避免自己算自己
        If ws.Name <> summaryWs.Name Then
            summaryWs.Cells(rowNum, 1).Value = ws.Name

            ' 分別填入 Q, R, S, T 的最大值
            For i = 0 To 3
                summaryWs.Cells(rowNum, i + 2).Value = _
                    Application.WorksheetFunction.Max(ws.Columns(colArray(i)))
            Next i

            rowNum = rowNum + 1
        End If
    Next ws

    ' 4. 格式美化
    summaryWs.Columns("A:E").AutoFit
    summaryWs.Activate

    MsgBox "所有工作表的 Q, R, S, T 最大值彙整完畢！", vbInformation
End Sub
※ 編輯: d0641237 (101.12.148.20 臺灣), 04/20/2026 21:50:49