Combining the VBA code of the Excel workbook with a score sheet is ideal for a friend _python

You also need to merge the worksheets together to form a summary table. At this time more trouble is also easier to make mistakes, because the number of each table is not necessarily consistent, aligned. Because some people may be missing the exam, some people will be wrong and so on. Dedicate the following code for merging student scores or other similar tables. This code is characterized by no need to use SQL or access, such as large-head software, only need Excel can be executed, very convenient, not slow. Reprint please do not clear the advertisement.
Isn't there a suitable LAN management software? Are your network management tools flexible enough to be efficient? Look at this network management software.
' =============================================
' Number of tables not participating in the calculation when merging the total table
' Because the general merged table is on the last worksheet, exclude the table.
Const Excludesheetcount = 1
' main function, because ADO is used, you must make the following reference to run this code.
' Tools > references, referencing ADO (Microsoft ActiveX Data Objects 2.X Library)
' Link all sheet to a total table
' The first row of the table to be merged must be a field name, not a 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 the test numbers
' 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 ';d ata 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 [merged $] Set language = ' 1 '
' Equivalent to INNER join
' SQL = ' Select Tt.id,ta.score as language, Tb.score as English from [merged $] as TT, [language $] as TA, [English $] as TB
' sql = SQL & ' WHERE (tt.id = ta.id) and (tt.id = tb.id) "
' Left-Join all tables
' The statement passed the test
' SQL = ' Select Tt.id,ta.score as language, Tb.score as English from ([merged $] 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 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 a row in the first row of the table, and then merge the cells, plus the descriptive 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 (A) & Chr (a) & _
"The general table for the calculation of the generation, a number of single subjects of the objective problems combined to avoid manual processing by the test number is not aligned and lead to dislocation." "& Chr & Chr (a) & _
"Note: If the same test number exists in a single score table, the results of the test in the general table are inaccurate." "& Chr & Chr (a) & _
"Fill in the wrong test number, generally appear in the top or bottom of the table"
Ws. Cells (1, 1) = S1
Activesheet.rows (1). RowHeight = 80
' Freeze pane
Activesheet.rows (3). Select
Activewindow.freezepanes = True
Activewindow.smallscroll down:=0
End Sub
' Set 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
With Selection.borders (xledgetop)
. LineStyle = xlcontinuous
. Weight = Xlthin
. ColorIndex = xlautomatic
End With
With Selection.borders (Xledgebottom)
. LineStyle = xlcontinuous
. Weight = Xlthin
. ColorIndex = xlautomatic
End With
With Selection.borders (xledgeright)
. LineStyle = xlcontinuous
. Weight = Xlthin
. ColorIndex = xlautomatic
End With
With Selection.borders (xlinsidevertical)
. LineStyle = xlcontinuous
. Weight = Xlthin
. ColorIndex = xlautomatic
End With
With Selection.borders (xlinsidehorizontal)
. LineStyle = xlcontinuous
. Weight = Xlthin
. ColorIndex = xlautomatic
End With
End Sub
' Mark cells with no fractions to help find out which students have no scores on the answer card
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