chatgpt提醒Make sure to add a reference to the “Microsoft ActiveX Data Objects” library in your VBA project by going to “Tools” > “References” and checking the appropriate version (e.g., “Microsoft ActiveX Data Objects x.x Library”). 實測office2010 選用 2.8 library是可行。

Sub GetGroupedData()
    ' Define variables
    Dim wsResult As Worksheet
    Dim wsSource As Worksheet
    Dim rngSource As Range
    Dim rngResult As Range
    Dim strSQL As String
    Dim connString As String
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim rowIndex As Long
    Dim colIndex As Long
    Dim strSourceRng As String
    ' Set the source worksheet
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    
     Dim lastRow As Long
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
    strSourceRng = Trim("[Sheet1$A1:F" + Trim(Str(lastRow)) + "]")
        
    ' Check if the result sheet already exists
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("Result")
    On Error GoTo 0
    
    ' If the result sheet exists, clear its contents
    If Not wsResult Is Nothing Then
        Application.DisplayAlerts = False
        wsResult.Cells.Clear
        Application.DisplayAlerts = True
    Else
        ' If the result sheet doesn't exist, create it
        Set wsResult = ThisWorkbook.Worksheets.Add
        wsResult.Name = "Result"
    End If
    
    ' Define the range where the result will be displayed
    Set rngResult = wsResult.Range("A1")
    
    ' Connection string (Excel version-dependent)
    connString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";" & _
                 "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    
    ' SQL query to retrieve the grouped data
    'strSQL = "SELECT col1, col2, col3, col4, MIN(col5) AS MinValue, MAX(col6) AS MaxValue FROM [Sheet1$A1:N274] " & _
             "GROUP BY col1, col2, col3, col4"
    
    strSQL = "SELECT col1, col2, col3, col4, MIN(col5) AS MinValue, MAX(col6) AS MaxValue FROM " & strSourceRng & _
             "GROUP BY col1, col2, col3, col4"
    'wsSource.Range("N3").Value = strSQL
    
    ' Create a connection object
    Set cn = New ADODB.Connection
    
    ' Open the connection
    cn.Open connString
    
    ' Create a recordset object
    Set rs = New ADODB.Recordset
    
    ' Execute the query and populate the recordset
    rs.Open strSQL, cn
    
    ' Write the column headers to the result range
    For colIndex = 1 To rs.Fields.Count
        rngResult.Offset(0, colIndex - 1).Value = rs.Fields(colIndex - 1).Name
    Next colIndex
        rngResult.Offset(0, colIndex - 1).Value = "時數(HR)"
    ' Write the data to the result range
    rowIndex = 1
    Do Until rs.EOF
        For colIndex = 1 To rs.Fields.Count
            rngResult.Offset(rowIndex, colIndex - 1).Value = rs.Fields(colIndex - 1).Value
        Next colIndex
               ' Convert col5 and col6 to DateTime values
        Dim dt1 As Date
        Dim dt2 As Date
        dt1 = CDate(rs.Fields("MinValue").Value)
        dt2 = CDate(rs.Fields("MaxValue").Value)
        
        ' Calculate the difference and add as col7
        Dim diff As Double
        diff = dt2 - dt1
        rngResult.Offset(rowIndex, rs.Fields.Count).Value = Round(diff * 24, 2)
        
        rs.MoveNext
        rowIndex = rowIndex + 1
    Loop
    
    ' Clean up
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
    
    ' Format the result range as desired
    
    ' Optional: Autofit columns in the result range
    wsResult.Columns.AutoFit
End Sub

其中組合SQL語法from 片段時原本程式碼為
 ' Set the name of the sheet containing the data
    sheetName = "Sheet1"
    
    ' Set the range of data in Sheet1
    Set rngData = ThisWorkbook.Worksheets(sheetName).UsedRange
  
    ' SQL query to retrieve data from Sheet1
    strSQL = "SELECT * FROM [" & sheetName & "$" & rngData.Address & "]"

會有錯誤才改成自行抓取最後一筆，手動組成範圍。

原本不使用VBA與SQL語法，單純用excel Function來做
1.手動找出distinct的 上班日、員工代號、姓名、報工別
2.將上下工時間由字串改成日期時間 =DATEVALUE(上工時間) + TIMEVALUE(上工時間)，這樣才能做運算，算出時數。
3.=MAX(IF((A:A=L2)*(B:B=M2)*(D:D=O2),I:I)) 找出MAX值
  =MIN(IF((A:A=L2)*(B:B=M2)*(D:D=O2),H:H)) 找出MIN值
  其中L、M、O欄位第1.步驟抓出之distinct值 A、B、D為原始資料
4.Instead of pressing Enter, use Ctrl+Shift+Enter to enter the formula as an array formula. This will enclose the formula in curly braces {} and calculate the distinct values based on the three columns
5.差異為=(MAX-MIN)*24