excel成绩表-（纯代码）Excel VBA-WE016「一键完成学生成绩的收集和排序」

Sub Fenshu()Set ws0 = ActiveSheetfpath = [V1]rmax = [A65535].End(xlUp).Row()For i = 1 To 3 If i = 1 Then KeMu = "语文" If i = 2 Then KeMu = "数学" If i = 3 Then KeMu = "英语" cfile = Dir(fpath & "" & "*" & KeMu & "*.xls*") If cfile <> "" Then Set wbTarget = Workbooks.Open(fpath & "" & cfile) Set wsT = wbTarget.Sheets(1) xh = Application.Match("学号", wsT.Range("1:1"), 0) cj = Application.Match("成绩", wsT.Range("1:1"), 0) wsname = wsT.Name rt = wsT.[A65535].End(xlUp).Row() ct = wsT.[AAA1].End(xlToLeft).Column() cke = Application.Match(KeMu, ws0.Range("1:1"), 0) ws0.Range(Cells(2, cke), Cells(rmax, cke)).FormulaR1C1 = _ "=VLOOKUP(RC1,[" & cfile & "]" & wsname & "!C" & _ xh & ":C" & cj & "," & cj - xh + 1 & ",0)" wbTarget.Close cke2 = Application.Match(KeMu & "排序", ws0.Range("1:1"), 0) ws0.Range(Cells(2, cke2 - 1), Cells(rmax, cke2 - 1)) = ws0.Range("B2:B" & rmax).Value ws0.Range(Cells(2, cke2), Cells(rmax, cke2)) = _ ws0.Range(Cells(2, cke), Cells(rmax, cke)).Value ws0.Range(Cells(2, cke2 - 1), Cells(rmax, cke2)).Sort key1:=ws0.Cells(1, cke2) ws0.Columns(cke2).Select With Selection .FormatConditions.AddTop10 .FormatConditions(.FormatConditions.Count).SetFirstPriority .FormatConditions(1).Percent = False .FormatConditions(1).Rank = 5 .FormatConditions(1).TopBottom = xlTop10Top .FormatConditions(1).Interior.Pattern = xlPatternSolid .FormatConditions(1).Interior.ThemeColor = 9 End With Else MsgBox KeMu & "：成绩表找不到" End IfNextRange(Cells(2, 6), Cells(rmax, 6)).FormulaR1C1 = "=SUM(RC3:RC5)"cke2 = Application.Match("总分排序", ws0.Range("1:1"), 0)Range(Cells(2, cke2 - 1), Cells(rmax, cke2 - 1)) = ws0.Range("B2:B" & rmax).ValueRange(Cells(2, cke2), Cells(rmax, cke2)) = Range(Cells(2, 6), Cells(rmax, 6)).ValueRange(Cells(2, cke2 - 1), Cells(rmax, cke2)).Sort key1:=Cells(1, cke2)Columns(cke2).SelectWith Selection .FormatConditions.AddTop10 .FormatConditions(.FormatConditions.Count).SetFirstPriority .FormatConditions(1).Percent = False .FormatConditions(1).Rank = 5 .FormatConditions(1).TopBottom = xlTop10Top .FormatConditions(1).Interior.Pattern = xlPatternSolid .FormatConditions(1).Interior.ThemeColor = 10End WithApplication.ReferenceStyle = xlA1End Sub