合并Excel工作薄中成績表的VBA代碼，非常適合教育一線的朋友
2020-02-23 04:43:38
供稿：網友
這時候還需要把各個工作表合并到一起來形成一個匯總表。這時候比較麻煩也比較容易出錯，因為各個表的學號不一定都是一致的、對齊的。因為可能會有人缺考，有人會考號涂錯等等。特奉獻以下代碼，用于合并學生成績表或者其它類似的表都可以。本代碼特點在于不需要使用SQL或者Access等大頭軟件，只需要Excel就可以執行，非常方便，速度也不慢。轉載請勿清除廣告。
沒有合適的局域網管理軟件嗎？你的網管工具夠靈活夠高效嗎？看看這個network management software。
' =============================================
' 合并總表時，不參加計算的表格數目
' 因為一般合并的總表放在最后一個工作表，要排除掉這個表。
Const ExcludeSheetCount = 1
' 主函數，因為用到了ADO，必須作如下引用才能運行本代碼。
' 工具>引用， 引用ADO(Microsoft ActiveX Data Objects 2.X Library)
' 鏈接所有sheet到一個總表
' 要合并的表的第一行必須是字段名稱，不能是合并單元格
Sub SQL_ADO_EXCEL_JOIN_ALL()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, k, shCount As Integer
Dim SQL, SQL2 As String, cnnStr As String
Dim s1, s2, s3, tmp As String
Dim ws As Worksheet
Const IDIdx = 1
Const ScoreIdx = 3
shCount = ActiveWorkbook.Sheets.Count
' 獲取所有考號
' EXCEL 會自動去除重復數據
' SQL = "(select ID from [語文$]) union (select ID from [英語$]) union (select ID from [物理$]) order by ID"
SQL = ""
For i = 1 To shCount - ExcludeSheetCount
s1 = "(SELECT ID FROM [" & Sheets(i).Name & "$])"
If i = 1 Then
SQL = s1
Else
SQL = SQL & " UNION " & s1
End If
Next
'MsgBox SQL
Set ws = ActiveWorkbook.Sheets(shCount)
cnnStr = "provider = microsoft.jet.oledb.4.0;Extended Properties='Excel 8.0;HDR=yes;IMEX=1';data source=" & ThisWorkbook.FullName
cnn.CursorLocation = adUseClient
cnn.ConnectionString = cnnStr
cnn.Open
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
ws.Activate
ws.Cells.Clear
For i = 1 To rs.Fields.Count
ws.Cells(1, i) = rs.Fields(i - 1).Name
Next
ws.Range("A2").CopyFromRecordset rs
For i = 1 To shCount - ExcludeSheetCount
Sheets(shCount).Cells(1, i + 1) = Sheets(i).Name
Next
'EXCEL 不支持 UPDATE
'SQL = "update [合并$] set 語文 = '1'"
' 相當于內聯接
'SQL = "select tt.ID,ta.score as 語文,tb.score as 英語 from [合并$] AS tt, [語文$] as ta, [英語$] as tb "
'SQL = SQL & "where (tt.ID = ta.ID) and (tt.ID = tb.ID)"
' 左聯接所有表格
' 通過測試的語句
'SQL = "select tt.ID,ta.score AS 語文,tb.score as 英語 from ([合并$] AS tt left join [語文$] as ta on tt.ID = ta.ID) "
'SQL = SQL & "left join [英語$] as tb on tt.ID = tb.ID"
SQL2 = "([" & Sheets(shCount).Name & "$] AS tt LEFT JOIN [" & Sheets(1).Name & "$] AS t1 ON tt.id=t1.id) "
