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
