Merge the VBA code of the sheet in the Excel worksheet, which is very suitable for educating first-line friends.

At this time, you need to combine the worksheets to form a summary table. At this time, it is troublesome and prone to errors, because the student IDs of different tables are not necessarily consistent and aligned. Because some people may be absent from the exam, some may be wrong. Provide the following code to merge student orders tables or other similar tables. This Code does not need to use SQL, Access, and other software. It can be executed only in Excel, which is very convenient and fast. Reprinted. Do not clear the advertisement.
Are there any suitable LAN Management Software? Is your network management tool flexible and efficient? Check out this network management software.
'================================================ ======
'The number of tables not included in the calculation when the summary table is merged
'Because the consolidated summary table is generally placed in the last worksheet, this table should be excluded.
Const ExcludeSheetCount = 1
'Main function. Because ADO is used, you must make the following reference to run this code.
'Tool> reference, reference ADO (Microsoft ActiveX Data Objects 2.X Library)
'Link all sheet to a summary table
'The first row of the table to be merged must be the field name, not the merged cell.
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
'Get all exam IDS
'Excel automatically removes duplicate data
'SQL = "(select ID from [language $]) union (select ID from [English $]) union (select ID from [physical $]) 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 does not support UPDATE
'SQL = "update [merge $] set Language = '1 '"
'Is equivalent to inner join
'SQL = "select tt. ID, ta. score as language, tb. score as English from [merge $] AS tt, [language $] as ta, [English $] as tb"
'SQL = SQL & "where (tt. ID = ta. ID) and (tt. ID = tb. ID )"
'Left join all tables
'Test passed statement
'SQL = "select tt. ID, ta. score AS language, tb. score as English from ([merge $] AS tt left join [language $] as ta on tt. ID = ta. ID )"
'SQL = SQL & "left join [English $] 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 )"
SQL = "SELECT tt. ID ,"
For I = 1 To shCount-ExcludeSheetCount
Tmp = "t" & I
SQL = SQL & tmp & ". score AS" & Sheets (I). Name
If I <shCount-ExcludeSheetCount Then SQL = SQL &","
If I> 1 Then
SQL2 = "(" & SQL2 & "left join [" & Sheets (I ). name & "$] AS" & tmp & "ON tt. id = "& tmp &". id )"
End If
Next
S1 = SQL & "FROM" & SQL2 & "ORDER BY tt. ID"
MsgBox s1
Rs. Close
Rs. Open s1, cnn, adOpenKeyset, adLockOptimistic
'Clear the table
Ws. Activate
Cells. Select
Selection. Delete Shift: = xlUp
For I = 1 To rs. Fields. Count
Ws. Cells (1, I) = rs. Fields (I-1). Name
Next
Ws. Range ("A2"). CopyFromRecordset rs
Rs. Close
Cnn. Close
Set rs = Nothing
Set cnn = Nothing
Call AddHeader
Call FindBlankCells
Call TableBorderSet
Ws. Columns (1). AutoFit
Ws. Cells (2, 1). Select
MsgBox "Finished ."
End Sub
'Insert the row in the first row of the table, merge the cells, and add the explanatory text.
Sub AddHeader ()
Dim ws As Worksheet
Dim s1, s2 As String
ShCount = ActiveWorkbook. Sheets. Count
Set ws = Sheets (shCount)
Column = ws. UsedRange. Columns. Count
Ws. Rows (1). Insert
S1 = Chr (Asc ("A") + Column-1)
S2 = "A1:" & s1 & "1"
Ws. Range (s2). Merge
Ws. Rows (1). RowHeight = 100
S1 = "Description" & Chr (13) & Chr (10 )&_
"This summary table is generated for calculation. The objective questions and scores of several single subjects are combined to avoid misplacement due to misaligned exam numbers during manual processing. "& Chr (13) & Chr (10 )&_
"NOTE: If the same exam number exists in a single subject list, the score for this exam number in the total table is inaccurate. "& Chr (13) & Chr (10 )&_
"Fill in the wrong exam number, usually at the top or bottom of the table"
Ws. Cells (1, 1) = s1
ActiveSheet. Rows (1). RowHeight = 80
'Freeze the pane
ActiveSheet. Rows (3). Select
ActiveWindow. FreezePanes = True
ActiveWindow. SmallScroll Down: = 0
End Sub
'Set the table border
Sub TableBorderSet ()
ActiveSheet. UsedRange. Select
Selection. Borders (xlDiagonalDown). LineStyle = xlNone
Selection. Borders (xlDiagonalUp). LineStyle = xlNone
With Selection. Borders (xlEdgeLeft)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End
With Selection. Borders (xlEdgeTop)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End
With Selection. Borders (xlEdgeBottom)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End
With Selection. Borders (xlEdgeRight)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End
With Selection. Borders (xlInsideVertical)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End
With Selection. Borders (xlInsideHorizontal)
. LineStyle = xlContinuous
. Weight = xlThin
. ColorIndex = xlAutomatic
End
End Sub
'Mark cells with no scores to help you identify students who have no scores in the answer sheet
Sub FindBlankCells ()
Dim I, j, row, col As Integer
'Activesheet. Cells (2, 1). Interior. ColorIndex = 15
Row = ActiveSheet. UsedRange. Rows. Count
Col = ActiveSheet. UsedRange. Columns. Count
For I = 2 To row
For j = 2 To col
If IsEmpty (ActiveSheet. Cells (I, j). Value) Then
ActiveSheet. Cells (I, j). Interior. ColorIndex = 15
End If
Next
Next
End Sub