第一次自学VBA

希望的效果如图所示

 

 

Sub CopyClassAvgCell() Dim a As Range Dim i As Integer Dim cell As String Dim nameCell As String Dim schoolAvgCell As String Dim classAvgCell As String Dim mergeCell As String Dim totalAvgCell As String Dim dstCell As String Dim j As Integer ''''''''''''''''''''''''从Sheet1获取关键数据到Sheet2 j = 1 For i = 7 To 511 Step 8 Worksheets("Sheet1").Activate cell = "Q" + CStr(i) nameCell = "C" + CStr(i - 2) Range(cell).Select Selection.Copy Worksheets("Sheet2").Activate dstCell = "C" + CStr(j) Range(dstCell).PasteSpecial xlPasteValues dstCell = "D" + CStr(j) schoolAvgCell = "R" + CStr(i) Range(dstCell).Select ActiveCell.FormulaR1C1 = Worksheets("Sheet1").Range(schoolAvgCell).Value dstCell = "A" + CStr(j) Range(dstCell).Select ActiveCell.FormulaR1C1 = CStr(j) dstCell = "B" + CStr(j) Range(dstCell).Select ActiveCell.FormulaR1C1 = Worksheets("Sheet1").Range(nameCell).Value j = j + 1 Next i '''''''''''''''''''''''' 以C为主键排序Sheet2中的数据 Worksheets("Sheet2").Range("C1").Sort _ Key1:=Worksheets("Sheet2").Columns("C"), _ Header:=xlGuess '''''''''''''''''''''''' 将Sheet2的数据重新插回到Sheet1 j = 1 For i = 7 To 511 Step 8 Worksheets("Sheet1").Activate mergeCell = "C" + CStr(i) + ":R" + CStr(i) Range(mergeCell).Select Selection.Merge dstCell = "C" + CStr(i) totalAvgCell = "A" + CStr(j) classAvgCell = "C" + CStr(j) schoolAvgCell = "D" + CStr(j) Range(dstCell).Value = "平均分1" + CStr(Worksheets("Sheet2").Range(classAvgCell).Value) + " " + _ "平均分2" + CStr(Worksheets("Sheet2").Range(schoolAvgCell).Value) + " " + _ "平均分3" + CStr(Worksheets("Sheet2").Range(totalAvgCell).Value) j = j + 1 Next i End Sub